.plan

tail -n +1 file1.txt file2.txt file3.txt

==> file1.txt <==
<contents of file1.txt>

==> file2.txt <==
<contents of file2.txt>

==> file3.txt <==
<contents of file3.txt>

# Numeric prefixes a la vim
bind 1 switch-client -Ttable1
...
# Use ta to switch sessions
bind C-p popup -E -E "ta --height 100%"
bind -Ttable1 C-p popup -E -E "NOCACHE=1 ta --height 100%"

// ==UserScript==
// @name         Enhanced OS-Specific Font Fallbacks
// @namespace    http://tampermonkey.net/
// @version      1.9
// @description  Apply OS-specific font fallbacks with improved OS detection and HTML element consideration
// @match        *://*/*
// @grant        GM_addStyle
// ==/UserScript==

(function() {
    'use strict';

    // Function to determine the OS
    function getOS() {
        if (navigator.userAgentData) {
            // Modern approach using userAgentData
            const platform = navigator.userAgentData.platform.toLowerCase();
            if (platform.includes('mac')) return 'MacOS';
            if (platform.includes('win')) return 'Windows';
        } else {
            // Fallback to platform for older browsers
            const platform = navigator.platform.toLowerCase();
            if (platform.includes('mac')) return 'MacOS';
            if (platform.includes('win')) return 'Windows';
        }
        return 'Unknown';
    }

    // Get the current OS
    const currentOS = getOS();

    // Define OS-specific font stacks
    const osFonts = {
        MacOS: {
            serif: 'Georgia, "Times New Roman", Times, serif',
            sansSerif: '"SF Pro Text", "Helvetica Neue", -apple-system, BlinkMacSystemFont, Roboto, Arial, sans-serif',
            monospace: '"SF Mono", Menlo, Monaco, Consolas, "Liberation Mono", "Courier New", monospace'
        },
        Windows: {
            serif: '"Cambria", "Times New Roman", Times, serif',
            sansSerif: '"Segoe UI", Roboto, "Helvetica Neue", Arial, sans-serif',
            monospace: 'Consolas, "Liberation Mono", "Courier New", monospace'
        },
        Unknown: {
            serif: 'Georgia, "Times New Roman", Times, serif',
            sansSerif: '-apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, Helvetica, Arial, sans-serif',
            monospace: 'Menlo, Consolas, Monaco, "Liberation Mono", "Courier New", monospace'
        }
    };

    const baseCSS = `
    :root {
      --os-serif: ${osFonts[currentOS].serif};
      --os-sans-serif: ${osFonts[currentOS].sansSerif};
      --os-monospace: ${osFonts[currentOS].monospace};
    }`;

    GM_addStyle(baseCSS);

    // Function to check if an element has a custom font-family set
    function hasCustomFontFamily(element) {
        // Check inline style
        if (element.style.fontFamily) {
            return true;
        }

        // Check stylesheets
        const styles = document.styleSheets;
        for (let i = 0; i < styles.length; i++) {
            let rules;
            try {
                rules = styles[i].cssRules || styles[i].rules;
            } catch (e) {
                continue; // Skip cross-origin stylesheets
            }
            for (let j = 0; j < rules.length; j++) {
                let rule = rules[j];
                if (rule.style && rule.style.fontFamily) {
                    if (element.matches(rule.selectorText)) {
                        return true;
                    }
                }
            }
        }

        return false;
    }

    // Function to test default fonts and apply fallbacks if needed
    function testAndApplyFallbacks() {
        const testDiv = document.createElement('div');
        testDiv.style.visibility = 'hidden';
        testDiv.style.position = 'absolute';
        testDiv.style.top = '-9999px';
        document.body.appendChild(testDiv);

        let cssRules = [];

        // Check html and body font
        if (!hasCustomFontFamily(document.documentElement) && !hasCustomFontFamily(document.body)) {
            cssRules.push(`html, body { font-family: var(--os-serif); }`);
        }

        // Check monospace elements
        const monoElements = ['pre', 'code', 'kbd', 'samp'];
        monoElements.forEach(tag => {
            const el = document.createElement(tag);
            testDiv.appendChild(el);
            if (!hasCustomFontFamily(el)) {
                cssRules.push(`${tag} { font-family: var(--os-monospace); }`);
            }
            testDiv.removeChild(el);
        });

        document.body.removeChild(testDiv);

        if (cssRules.length > 0) {
            GM_addStyle(cssRules.join('\n'));
        }
    }

    // Wait for the page to load before testing fonts and applying fallbacks
    if (document.readyState === 'loading') {
        document.addEventListener('DOMContentLoaded', testAndApplyFallbacks);
    } else {
        testAndApplyFallbacks();
    }
})();

docker run --name app-web-assets ... \
    --entrypoint sleep <app-image> ...

docker cp -L app-web-assets:/rails/public/assets/. <folder>

docker stop -t 1 app-web-assets

docker run ... \
    --volume <combined asset folder>:/rails/public/assets ...

function getScrollbarWidth() {

  // Creating invisible container
  const outer = document.createElement('div');
  outer.style.visibility = 'hidden';
  outer.style.overflow = 'scroll'; // forcing scrollbar to appear
  outer.style.msOverflowStyle = 'scrollbar'; // needed for WinJS apps
  document.body.appendChild(outer);

  // Creating inner element and placing it in the container
  const inner = document.createElement('div');
  outer.appendChild(inner);

  // Calculating difference between container's full width and the child width
  const scrollbarWidth = (outer.offsetWidth - inner.offsetWidth);

  // Removing temporary elements from the DOM
  outer.parentNode.removeChild(outer);

  return scrollbarWidth;
}

function useBodyScrollable() {
    const [bodyScrollable, setBodyScrollable] = useState(
        document.body.scrollHeight > window.innerHeight
    )
    useEffect(() => {
        const resizeObserver = new ResizeObserver(() => {
            setBodyScrollable(document.body.scrollHeight > window.innerHeight)
        })
        resizeObserver.observe(document.body)
        return () => {
            resizeObserver.unobserve(document.body)
        }
    }, [])
    return bodyScrollable
}

  ...
  const bodyScrollable = useBodyScrollable()
  useLayoutEffect(() => {
      if (bodyScrollable) {
          document.body.style.paddingRight = '0px'
      } else {
          document.body.style.paddingRight = `${scrollbarWidth}px`
      }
  }, [bodyScrollable])
  ...

@Sse('subscribe')
sse(@UserWithOrganization() user: AuthenticatedUser, @Res() res: Response): Observable<MessageEvent> {
  const notifications$ = this.notificationsEventService.subscribe(user.profileId, user.organizationId).pipe(map((data) => ({ data })));
  const keepAlive$ = interval(this.configService.get('app.sseKeepAliveInterval')).pipe(
    tap(() => res.write(': keepalive\n\n')),
    filter(() => false)
  ) as Observable<MessageEvent>;
  return merge(keepAlive$, notifications$);
}

export interface MessageEvent {
    data: string | object;
    id?: string;
    type?: string;
    retry?: number;
}

id: 1

id: 2

id: 3

...

import { EffectCallback, DependencyList, useEffect } from 'react';

const useEffectsVerbose = (effect: EffectCallback, deps: DependencyList) => {
  useEffect(() => {
    console.log('MOUNT');
    return () => console.log('UNMOUNT');
  }, []);
  for (let each of deps) {
    // eslint-disable-next-line react-hooks/rules-of-hooks
    useEffect(() => {
      console.log('CHANGED', each);
    }, [each]);
  }
  useEffect(effect, deps); // eslint-disable-line react-hooks/exhaustive-deps
};

export default useEffectsVerbose;

import { useEffect, useState } from 'react';

type UseEventSourceReturn<T> = {
  data: T | undefined;
  error: Event | undefined;
};

const useEventSource = <T>(url: string, init?: EventSourceInit): UseEventSourceReturn<T> => {
  const [data, setData] = useState<T>();
  const [error, setError] = useState<Event>();

  useEffect(() => {
    const es = new EventSource(url, init);

    es.onmessage = (e) => {
      setData(JSON.parse(e.data));
    };

    es.onerror = (err) => {
      setError(err);
      es.close();
    };

    return () => {
      es.close();
    };
  }, [url, init]);

  return { data, error };
};

export default useEventSource;

import { useEffect, useState } from 'react';

const INTERSECTION_OBSERVER_INIT = {
  root: null,
  rootMargin: '0px',
  threshold: 0.75,
};

const useIntersectionObserver = (
  node: HTMLElement | null,
  opts: IntersectionObserverInit | undefined = INTERSECTION_OBSERVER_INIT,
) => {
  const [observedEntry, setObservedEntry] = useState<IntersectionObserverEntry>();

  useEffect(() => {
    const observer = new IntersectionObserver(([entry]) => setObservedEntry(entry), opts);

    if (node) {
      observer.observe(node);
    }

    return () => observer.disconnect();
  }, [node, opts]);

  return { observedEntry };
};

export default useIntersectionObserver;

import { useEffect, useState } from 'react';
import { isMobile } from 'react-device-detect';

const useVirtualKeyboardVisibility = (minBrowserToolbarHeight = 200) => {
  const [visible, setVisible] = useState(isVisible(minBrowserToolbarHeight));

  useEffect(() => {
    if (!isMobile) {
      return;
    }
    function handler() {
      if (visible !== isVisible(minBrowserToolbarHeight)) {
        setVisible(!visible);
      }
    }
    window.visualViewport.addEventListener('resize', handler);
    return () => {
      window.visualViewport.removeEventListener('resize', handler);
    };
  }, [visible, minBrowserToolbarHeight]);

  return visible;
};

function isVisible(minDelta: number) {
  return window.screen.height - document.body.clientHeight > minDelta;
}

export default useVirtualKeyboardVisibility;

let resource = {
  user: wrapPromise(fetch(...)),
};

function wrapPromise(promise) {
  let status = "pending";
  let result;
  let suspender = promise.then(
    r => {
      status = "success";
      result = r;
    },
    e => {
      status = "error";
      result = e;
    }
  )
  return {
    read() {
      if (status === "pending") {
        throw suspender;
      } else if (status === "error") {
        throw result;
      } else if (status === "success") {
        return result;
      }
    }
  }
}

function ProfileDetails() {
  const user = resource.user.read();
  return <h1>{user.name}</h1>
}

// before
let hasOwnProp = Object.prototype.hasOwnProperty;
let obj = { x: 100 };
hasOwnProp.call(obj, "x");
// after
let hasOwnProp = Object.prototype::hasOwnProperty;
obj.hasOwnProp("x")

// before
Promise.resolve(123).then(console.log.bind(console));
// after
Promise.resolve(123).then(::console.log);

- [proposal-call-this](https://github.com/tc39/proposal-call-this)

data:text/html,<host-element><template shadowroot="open"><slot></slot></template><h2>Light content</h2></host-element>

factorial n = product (range 1 (n+1))
blah      n = product (range 1 (n+1))
blah2     z = product (range 1 (z+1))

.unison/
  j1ejquc/ # hash
    ast.ub
    names/
      factorial
      blah
      blah2

factorial =
  $arg1 -> #8h7jbs5 (#h9bwx9q 1 (#e2i3biw $arg 1))

$ $BASH --version
GNU bash, version 3.2.57(1)-release (x86_64-apple-darwin20)
Copyright (C) 2007 Free Software Foundation, Inc.

$ $(brew --prefix)/bin/bash --version
GNU bash, version 5.1.16(1)-release (x86_64-apple-darwin20.6.0)
Copyright (C) 2020 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>

This is free software; you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
$ echo $(brew --prefix)/bin/bash
/usr/local/bin/bash

data:text/html,<style>* { background: %230001 }</style><div>foo<div>bar<div>baz

data:text/html,<style>a { background: rgba(255,255,0,0.5) } * { border: 1px solid black; padding: 1em; margin: 1em } b { outline: 5px dotted red }</style><div id=div><a>foo<b>bar<a>baz</div><pre id=pre></pre><script>pre.innerText = div.innerHTML</script>

data:text/html,<style>a { background: rgba(255,255,0,0.5) } * { border: 1px solid black; padding: 1em; margin: 1em } b { outline: 5px dotted red }</style><div id=div><a>foo<b id=b>bar<a>baz</div><pre id=pre></pre><script>pre.innerText = div.innerHTML</script>

data:text/html,foo<plaintext>bar</plaintext>baz

<html>[...html document...]<plaintext>[...arbitrary document...]

data:text/html,foo<script>onload = () => document.body.append(123)</script><plaintext>bar</plaintext>baz

- It's a difficult problem to be able to rank objects coming from different sources
- It does not surprise me that they avoided this in the first iteration
- I meant to ask about this during the Q&A at ReplCon, but run out of time...

- 30 seconds is a lot of time, so that should give you plenty of time to figure out a way to search and retrieve all the data you have
- they most likely have their search engine scattered across different servers, with lots of RAM available for grabs
- they don't have commingled search, so they can search different indexes in parallel, and populate the search results page on a first-come-first-served basis, giving then time to the slowest paths, to catch up

- You can change directory
- You an see what's inside the current directory
- You can create a new file in the current directory
- You can delete a file from the current directory
- You would **never** use a SHELL that did not offer those 4 basic functionalities

- You should be able to change module
- You should be able to inspect the current module
- You should be able define a new function in the current module
- You should be able to delete a function from the current module
- Why then settle for a REPL that did not offer the same 4 basic functionalities?

- It cannot be done with Swift-UI, or Flutter

form:has(input:invalid) {
  border: 2px solid red;
}

var lrServer = livereload.createServer({ port: 35729, host: '127.0.0.1' });
lrServer.watch(__dirname + "/public");

var ioServer = http.createServer((req, res) => {
  res.writeHead(404);
  res.end();
});
ioServer.listen(23434, '127.0.0.1')
var io = socket(ioServer);

var app = express();
app.use(createProxyMiddleware('/lr', {
  target: 'http://127.0.0.1:35729',
  ws: true,
  pathRewrite: {
    '^/lr': '',
  },
}));
app.use(createProxyMiddleware('/socket.io', {
  target: 'http://127.0.0.1:23434',
  ws: true,
}));
var server = http.createServer(app);
server.listen(3000, '0.0.0.0');

document.write(
  '<script src="' +
    location.protocol +
    '//' +
    location.host +
    '/lr/livereload.js?snipver=1' + (location.protocol === 'https:' ? '&port=443' : '') + '&path=lr"></' +
    "script>"
);

When I open my note-taking app first thing in the morning -> ask what I'm currently thinking about. Once I've marked this complete, show me what I said yesterday, 3 days ago, and last week.

When I create a note related to a specific book -> pull in the author, cover, and publication date from the Google Books API.

When a week has passed since I've written notes on a book -> ask me everything I remember about it off the top of my head. Put this into the summary section of my notes as a first draft.

When I mark an essay draft as complete -> ask me all the questions my favourite writing professor would ask.

- Do you actually have a point and have you made it?
- Does your introduction present a compelling problem?
- Are you assuming the audience is thicker than a brick?
- Is this littered with passive voice (to be, is, was, were...) and evasive language?

p5.image(
  OFFSCREEN,
  // destination
  0, 0, p5.windowWidth, p5.windowHeight,
  // source
  view.x, view.y, view.w, view.h,
);

p5.image(
  OFFSCREEN,
  -view.x / scale(),
  -view.y / scale(),
  width / scale(),
  height / scale(),
);

function scale() {
  return view.w / p5.windowWidth;
}

Uncaught RangeError: Failed to execute 'getImageData' on 'CanvasRenderingContext2D': Out of memory at ImageData creation
    at d.default.Renderer2D.loadPixels (cdn.skypack.dev/-/p5@v1.4.1-EGzjLa9vkIOCBSEWMsHC/dist=es2019,mode=imports/optimized/p5.js:10747:130)
    at s.default.Graphics.h.default.loadPixels (cdn.skypack.dev/-/p5@v1.4.1-EGzjLa9vkIOCBSEWMsHC/dist=es2019,mode=imports/optimized/p5.js:13082:73)
    at Object.h.default._copyHelper (cdn.skypack.dev/-/p5@v1.4.1-EGzjLa9vkIOCBSEWMsHC/dist=es2019,mode=imports/optimized/p5.js:13071:12)
    at s.default.Graphics.h.default.copy (cdn.skypack.dev/-/p5@v1.4.1-EGzjLa9vkIOCBSEWMsHC/dist=es2019,mode=imports/optimized/p5.js:13069:29)
    at draw (:3000/main.js:391:12)
    at add (:3000/main.js:377:20)
    ...

setInterval(function syncToDisk() {
  const today = moment.utc();
  const copy = {};
  for (const key of Object.keys(state)) {
    const cdate = moment.utc(key.substring(1, 9), "YYYYMMDD");
    if (today.diff(cdate, 'days') < 15) {
      copy[key] = state[key];
    }
  }
  fs.writeFile("state.json", JSON.stringify(copy), function writeFileCb(err) {
    if (err) throw err;
    console.log(`Persisted [state=${JSON.stringify(copy)}]`);
  });
}, seconds(30));

var x = 'outer';
(function() {
  var x = 'inner';
  eval('console.log(x)'); // "inner"
})();

var x = 'outer';
(function() {
  var x = 'inner';
  [eval][0]('console.log(x)'); // "outer"
})();

Make Ctrl-Shift-K insert a fresh key in the editor
This isn't very useful yet, but it will be.

The idea is that you will write e.g.

    (defun foo (x) ~20220314.8ITJ8NXNXY
      (append '(1 2 x) '(a b c)))

to give FOO that key.  Then FOO will have a stable identifier even if
you rename it, which is great for URLs and other hypermedia stuff.

  // What does `p5.mouseX` currently points to?
  //
  //     x = view.x + (p5.mouseX / p5.windowWidth) * view.w
  //
  // While zooming, we don't want to change what `p5.mouseX` currently
  // points at, or otherwise the _camera_ would move.  This means
  // the the following should be true as well:
  //
  //     x = tview.x + (p5.mouseX / p5.windowWidth) * tview.w
  //
  // `x` is known from the first equation, `tview.w` we just
  // calculated it inside the previous block; all we have to do
  // is figure out `tview.x`:
  //
  //     x = view.x + (p5.mouseX / p5.windowWidth) * view.w
  //     x = tview.x + (p5.mouseX / p5.windowWidth) * tview.w
  //     ----------------------------------------------------
  //     0 = view.x - tview.x + (p5.mouseX / p5.windowWidth) * (view.w - tview.w)
  //     ----------------------------------------------------
  //     tview.x = view.x + (p5.mouseX / p5.windowWidth) * (view.w - tview.w)

#!/bin/sh
#
# Sample script for enabling/disabling GitHub Actions CI runs on
# particular refs. By default, CI is run for all branches pushed to
# GitHub. You can override this by dropping the ".sample" from the script,
# editing it, committing, and pushing the result to the "ci-config" branch of
# your repository:
#
#   git checkout -b ci-config
#   cp allow-refs.sample allow-refs
#   $EDITOR allow-refs
#   git commit -am "implement my ci preferences"
#   git push
#
# This script will then be run when any refs are pushed to that repository. It
# gets the fully qualified refname as the first argument, and should exit with
# success only for refs for which you want to run CI.

case "$1" in
# allow one-off tests by pushing to "for-ci" or "for-ci/mybranch"
refs/heads/for-ci*) true ;;
# always build your integration branch
refs/heads/my-integration-branch) true ;;
# don't build any other branches or tags
*) false ;;
esac

jobs:
  ci-config:
      runs-on: ubuntu-latest
      outputs:
        enabled: ${{ steps.check-ref.outputs.enabled }}
      steps:
        - name: try to clone ci-config branch
          continue-on-error: true
          run: |
            git -c protocol.version=2 clone \
              --no-tags \
              --single-branch \
              -b ci-config \
              --depth 1 \
              --no-checkout \
              --filter=blob:none \
              https://github.com/${{ github.repository }} \
              config-repo &&
              cd config-repo &&
              git checkout HEAD -- ci/config
        - id: check-ref
          name: check whether CI is enabled for ref
          run: |
            enabled=yes
            if test -x config-repo/ci/config/allow-ref &&
               ! config-repo/ci/config/allow-ref '${{ github.ref }}'
            then
              enabled=no
            fi
            echo "::set-output name=enabled::$enabled"

  windows-build:
    needs: ci-config
    if: needs.ci-config.outputs.enabled == 'yes'
    runs-on: windows-latest
    steps:
    - uses: actions/checkout@v1

Who does not love Lorem Ipsum?

Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor
incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis
nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.
Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu
fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in
culpa qui officia deserunt mollit anim id est laborum.

" also, renew the highlighted region
" only highlight, if we are in a different window
" then where we started, else we might accidentally
" set a match in the narrowed window (might happen if the
" user typed Ctrl-W o in the narrowed window)
if !(has_key(s:nrrw_rgn_lines[instn], 'single') || winnr != winnr())

@@ -1361,7 +1361,7 @@ fun! nrrwrgn#WidenRegion(force)  abort "{{{1
 		" then where we started, else we might accidentally
 		" set a match in the narrowed window (might happen if the
 		" user typed Ctrl-W o in the narrowed window)
-		if !(has_key(s:nrrw_rgn_lines[instn], 'single') || winnr != winnr())
+		if !(has_key(s:nrrw_rgn_lines[instn], 'single') || bufwinnr(orig_buf) != winnr())
 			call <sid>AddMatches(<sid>GeneratePattern(
 				\ s:nrrw_rgn_lines[instn].start[1:2],
 				\ s:nrrw_rgn_lines[instn].end[1:2],
@@ -1397,7 +1397,7 @@ fun! nrrwrgn#WidenRegion(force)  abort "{{{1
 		" then where we started, else we might accidentally
 		" set a match in the narrowed window (might happen if the
 		" user typed Ctrl-W o in the narrowed window)
-		if !(has_key(s:nrrw_rgn_lines[instn], 'single') || winnr != winnr())
+		if !(has_key(s:nrrw_rgn_lines[instn], 'single') || bufwinnr(orig_buf) != winnr())
 			call <sid>AddMatches(<sid>GeneratePattern(
 				\s:nrrw_rgn_lines[instn].start[1:2],
 				\s:nrrw_rgn_lines[instn].end[1:2],

augroup vlime_hilight_curr_expr
    autocmd!

    if empty(prop_type_get('lisp_curr_expr'))
        call prop_type_add('lisp_curr_expr', {'highlight': 'LispCurrExpr'})
    endif
    hi link LispCurrExpr MatchParen

    function! s:HilightCurrExpr() abort
        call prop_remove({'type': 'lisp_curr_expr', 'all': v:true})

        let expr = vlime#ui#CurExpr(1)
        if expr[0] == '' || expr[1][0] == 0
            return
        endif

        let [line1, col1] = expr[1]
        let [line2, col2] = expr[2]
        let l:options = {
                    \   'type': 'lisp_curr_expr',
                    \   'end_lnum': line2,
                    \   'end_col': col2,
                    \ }
        call prop_add(line1, col1, l:options)
    endfunction

    autocmd CursorMoved,CursorMovedI <buffer> call s:HilightCurrExpr()
augroup end

prettier --stdin-filepath "/Users/matteolandi/plan/NrrwRgn_.faang_1" 2> /var/folders/s1/zl3vtwg54_9_1s8fsxxtxpl00000gn/T/neoformat/stderr.log

[error] No parser could be inferred for file: /Users/matteolandi/plan/NrrwRgn_.faang_1

" While setting up the NrrwRgn buffer
let filename_with_ext = expand('%') . '.js'
execute "file" filename_with_ext
filetype detect

 thisaugroup neoformat_neoformat
  autocmd!

  " Thanks: https://github.com/sbdchd/neoformat/issues/134#issuecomment-347180213
  au BufWritePre * try | undojoin | Neoformat | catch /E790/ | Neoformat | endtry
augroup END

* swank-loader:*fasl-directory*
#P"/Users/matteolandi/.slime/fasl/2.27/sbcl-2.1.9-darwin-x86-64/"

diff --git a/swank-loader.lisp b/swank-loader.lisp
index 5434b9d1..44eb5437 100644
--- a/swank-loader.lisp
+++ b/swank-loader.lisp
@@ -159,7 +159,8 @@ Return nil if nothing appropriate is available."
    (make-pathname
     :directory `(:relative ".slime" "fasl"
                  ,@(if (slime-version-string) (list (slime-version-string)))
-                 ,(unique-dir-name)))
+                 ,(unique-dir-name)
+                 ,@(cdr (pathname-directory *load-truename*))))
    (user-homedir-pathname)))

* swank-loader:*fasl-directory*
#P"/Users/matteolandi/.slime/fasl/2.27/sbcl-2.1.9-darwin-x86-64/Users/matteolandi/my-env/opt/slime/__main__/"

(time
  (loop with cost-so-far = (make-hash-table :test 'equalp)
        with come-from = (make-hash-table :test 'equalp)
        with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
        initially (loop for row below rows do
                        (loop for col below cols do
                              (setf (gethash (list row col) burrow) (random 100))))
        repeat 10000 do
        (let ((next (copy-hash-table burrow))
              (row1 (random rows)) (col1 (random cols))
              (row2 (random rows)) (col2 (random cols)))
          (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
          (setf (gethash next cost-so-far) (random 1000)
                (gethash next come-from) burrow
                burrow next))
        finally (return cost-so-far)))
Evaluation took:
  8.908 seconds of real time
  8.398207 seconds of total run time (8.174489 user, 0.223718 system)
  94.27% CPU
  20,484,287,455 processor cycles
  13,913,664 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9414 {10032C19A3}>

> (time
    (flet ((key (row col) (+ (* row 100) col)))
      (loop with cost-so-far = (make-hash-table :test 'equalp)
            with come-from = (make-hash-table :test 'equalp)
            with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'eql)
            initially (loop for row below rows do
                        (loop for col below cols do
                              (setf (gethash (key row col) burrow) (random 100))))
            repeat 10000 do
            (let ((next (copy-hash-table burrow))
                  (row1 (random rows)) (col1 (random cols))
                  (row2 (random rows)) (col2 (random cols)))
              (rotatef (gethash (key row1 col1) next) (gethash (key row2 col2) next))
              (setf (gethash next cost-so-far) (random 1000)
                    (gethash next come-from) burrow
                    burrow next))
            finally (return cost-so-far))))
Evaluation took:
  7.051 seconds of real time
  6.668094 seconds of total run time (6.502108 user, 0.165986 system)
  94.57% CPU
  16,217,080,790 processor cycles
  11,858,336 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9389 {10041E7953}>

> (time
    (loop with cost-so-far = (make-hash-table :test 'equalp)
          with come-from = (make-hash-table :test 'equalp)
          with rows = 2 and cols = 10 with burrow = (make-array (list rows cols))
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (aref burrow row col) (random 100))))
          repeat 10000 do
          (let ((next (copy-array burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (aref next row1 col1) (aref next row2 col2))
            (setf (gethash next cost-so-far) (random 1000)
                  (gethash next come-from) burrow
                  burrow next))
          finally (return cost-so-far)))
Evaluation took:
  0.027 seconds of real time
  0.026169 seconds of total run time (0.016391 user, 0.009778 system)
  96.30% CPU
  62,550,110 processor cycles
  4,964,608 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9285 {1004F65393}>

> (time
    (loop with cost-so-far = (make-hash-table :test 'equalp)
          with come-from = (make-hash-table :test 'equalp)
          with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (gethash (list row col) burrow) (random 100))))
          repeat 10000 do
          (let ((next (copy-hash-table burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
            (let ((state-key (uiop:while-collecting (add)
                               (loop for row below rows do
                                     (loop for col below cols do
                                           (add (gethash (list row col) next)))))))
              (setf (gethash state-key cost-so-far) (random 1000)
                    (gethash state-key come-from) burrow
                    burrow next)))
          finally (return cost-so-far)))
Evaluation took:
  0.093 seconds of real time
  0.090564 seconds of total run time (0.052988 user, 0.037576 system)
  97.85% CPU
  214,038,690 processor cycles
  26,702,832 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9216 {10070F1E13}>

> (let ((cost-so-far (make-hash-table :test 'equalp))
        (come-from (make-hash-table :test 'equalp))
        states)
    ;; Generate all the states
    (time
      (loop with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
            initially (loop for row below rows do
                            (loop for col below cols do
                                  (setf (gethash (list row col) burrow) (random 100))))
            repeat 10000 do
            (let ((next (copy-hash-table burrow))
                  (row1 (random rows)) (col1 (random cols))
                  (row2 (random rows)) (col2 (random cols)))
              (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
              (let ((state-key next)
                    (cost-next (random 1000)))
                (push (list next state-key cost-next) states)
                (setf burrow next)))))
    ;; Update cost-so-far, came-from
    (time
      (loop for (state key cost) in states for prev = nil then state do
            (setf (gethash key cost-so-far) cost
                  (gethash key come-from) prev)))
Evaluation took:
  0.092 seconds of real time
  0.090417 seconds of total run time (0.070339 user, 0.020078 system)
  [ Run times consist of 0.067 seconds GC time, and 0.024 seconds non-GC time. ]
  97.83% CPU
  213,098,600 processor cycles
  12,494,080 bytes consed

Evaluation took:
  7.497 seconds of real time
  7.245294 seconds of total run time (7.097045 user, 0.148249 system)
  96.64% CPU
  17,254,061,811 processor cycles
  2,054,608 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9378 {10092E6233}>
#<HASH-TABLE :TEST EQUALP :COUNT 9378 {10092E62F3}>

> (let ((cost-so-far (make-hash-table :test 'equalp))
        (come-from (make-hash-table :test 'equalp))
        states)
    ;; Generate all the states
    (time
      (loop with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
            initially (loop for row below rows do
                            (loop for col below cols do
                                  (setf (gethash (list row col) burrow) (random 100))))
            repeat 10000 do
            (let ((next (copy-hash-table burrow))
                  (row1 (random rows)) (col1 (random cols))
                  (row2 (random rows)) (col2 (random cols)))
              (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
              (let ((state-key (uiop:while-collecting (add)
                                 (loop for row below rows do
                                       (loop for col below cols do
                                             (add (gethash (list row col) next))))))
                    (cost-next (random 1000)))
                (push (list next state-key cost-next) states)
                (setf burrow next)))))
    ;; Update cost-so-far, came-from
    (time
      (loop for (state key cost) in states for prev = nil then state do
            (setf (gethash key cost-so-far) cost
                  (gethash key come-from) prev)))
    (values cost-so-far come-from))
Evaluation took:
  0.034 seconds of real time
  0.034214 seconds of total run time (0.033711 user, 0.000503 system)
  100.00% CPU
  80,230,767 processor cycles
  25,301,488 bytes consed

Evaluation took:
  0.008 seconds of real time
  0.008258 seconds of total run time (0.008023 user, 0.000235 system)
  100.00% CPU
  19,813,576 processor cycles
  2,044,816 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9323 {1002275C53}>
#<HASH-TABLE :TEST EQUALP :COUNT 9323 {1002275D13}>

> (time
    (loop with cost-so-far = (make-hash-table :test 'equalp)
          with come-from = (make-hash-table :test 'equalp)
          with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (gethash (list row col) burrow) (random 100))))
          repeat 10000 do
          (let ((next (copy-hash-table burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
            (let ((state-key (hash-table-alist next)))
              (setf (gethash state-key cost-so-far) (random 1000)
                    (gethash state-key come-from) burrow
                    burrow next)))
          finally (return cost-so-far)))
Evaluation took:
  0.034 seconds of real time
  0.033374 seconds of total run time (0.032833 user, 0.000541 system)
  97.06% CPU
  78,876,062 processor cycles
  20,299,376 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9368 {1006C41283}>

> (time
    (loop with cost-so-far = '()
          with come-from = '()
          with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (gethash (list row col) burrow) (random 100))))
          repeat 10000 do
          (let ((next (copy-hash-table burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
            (let ((existing (assoc next cost-so-far :test 'equalp)))
              (if existing
                (setf (cdr existing) (random 1000))
                (setf cost-so-far (cons (cons next (random 1000)) cost-so-far))))
            (let ((existing (assoc next come-from :test 'equalp)))
              (if existing
                (setf (cdr existing) burrow)
                (setf come-from (cons (cons next burrow) come-from))))
            (setf burrow next))
          finally (return (length cost-so-far))))
Evaluation took:
  7.588 seconds of real time
  7.153604 seconds of total run time (7.015142 user, 0.138462 system)
  [ Run times consist of 0.043 seconds GC time, and 7.111 seconds non-GC time. ]
  94.28% CPU
  17,452,971,454 processor cycles
  12,449,472 bytes consed

9438

> (time
    (loop with cost-so-far = (make-hash-table :size 10000 :test 'equalp)
          with come-from = (make-hash-table :size 10000 :test 'equalp)
          with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (gethash (list row col) burrow) (random 100))))
          repeat 10000 do
          (let ((next (copy-hash-table burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
            (setf (gethash next cost-so-far) (random 1000)
                  (gethash next come-from) burrow
                  burrow next))
          finally (return cost-so-far)))
Evaluation took:
  7.296 seconds of real time
  7.080104 seconds of total run time (6.941640 user, 0.138464 system)
  97.04% CPU
  16,782,132,425 processor cycles
  12,445,328 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9301 {1003339C63}>

       ...
       (structure-object
        (cond ((hash-table-p key)
               ;; This is a purposely not very strong hash so that it does not make any
               ;; distinctions that EQUALP does not make. Computing a hash of the k/v pair
               ;; vector would incorrectly take insertion order into account.
               (mix (mix 103924836 (hash-table-count key))
                    (sxhash (hash-table-test key))))
              ((pathnamep key) (pathname-sxhash key))
              (t
               (structure-object-psxhash key depthoid))))
       ...

v...>>.vv>
.vv>>.vv..
>>.>v>...v
>>v>>.>.v.
v>v.vv.v..
>.>>..v...
.vv..>.>v.
v.v..>>v.v
....v..v.>

(defun parse-map (lines &aux (rows (length lines)) (cols (length (car lines))))
  (make-array (list rows cols) :element-type 'character :initial-contents lines))

(defun tick (curr &aux
                  (rows (array-dimension curr 0))
                  (cols (array-dimension curr 1))
                  (next (copy-array curr))
                  moved)
  (flet ((is (ch row col) (eql ch (aref curr row col)))
         (swap (row1 col1 row2 col2)
           (rotatef (aref next row1 col1) (aref next row2 col2))
           (setf moved t)))
    (dotimes (row rows)
      (dotimes (col cols)
        (let ((col-next (mod (1+ col) cols)))
          (when (and (is #\> row col) (is #\. row col-next))
            (swap row col-next row col)))))
    (setf curr next next (copy-array curr))
    (dotimes (row rows)
      (dotimes (col cols)
        (let ((row-next (mod (1+ row) rows)))
          (when (and (is #\v row col) (is #\. row-next col))
            (swap row-next col row col))))))
  (values next moved))

(defun part1 (map &aux (moved t))
  (loop while moved count t do (setf (values map moved) (tick map))))

(define-solution (2021 25) (input parse-map) (part1 input))

(define-test (2021 25) (532))

> (time (test-run))
TEST-2021/25.
Success: 1 test, 1 check.
Evaluation took:
  1.093 seconds of real time
  1.056084 seconds of total run time (1.034671 user, 0.021413 system)
  [ Run times consist of 0.006 seconds GC time, and 1.051 seconds non-GC time. ]
  96.61% CPU
  2,513,864,169 processor cycles
  81,222,576 bytes consed

TEST-2021/25.
Success: 1 test, 1 check.
Evaluation took:
  5.764 seconds of real time
  5.592039 seconds of total run time (5.371084 user, 0.220955 system)
  [ Run times consist of 0.221 seconds GC time, and 5.372 seconds non-GC time. ]
  97.02% CPU
  13,256,996,615 processor cycles
  1,541,412,576 bytes consed

      --------Part 1--------   --------Part 2--------
Day       Time   Rank  Score       Time   Rank  Score
 25   00:35:38   1765      0       >24h   7849      0
 24       >24h   9639      0       >24h   9523      0
 23       >24h  10091      0       >24h   8567      0
 22   00:16:12   1233      0   09:26:47   4814      0
 21   00:36:54   3629      0   06:33:55   6294      0
 20   01:18:22   2795      0   01:18:53   2519      0
 19   13:53:21   5731      0   13:59:27   5473      0
 18   09:38:24   6701      0   09:48:56   6514      0
 17   01:21:38   4923      0   01:47:03   4742      0
 16   01:42:44   3507      0   02:33:20   3958      0
 15   00:10:48    464      0   00:59:10   1927      0
 14   00:24:18   4237      0   01:38:04   4805      0
 13   00:56:19   6101      0   01:02:34   5368      0
 12   00:29:21   2620      0   01:09:05   3880      0
 11   00:37:06   3370      0   00:38:14   2960      0
 10   00:20:08   4481      0   00:30:26   3688      0
  9   00:14:25   3057      0   01:57:27   8388      0
  8   00:22:15   6338      0   11:31:30  25666      0
  7   00:11:03   4999      0   00:13:57   3206      0
  6   00:10:01   3043      0   00:39:17   4775      0
  5   07:28:10  27193      0   07:41:09  24111      0
  4   00:30:52   2716      0   00:41:34   2704      0
  3   00:12:42   4249      0   00:48:51   5251      0
  2   00:05:42   3791      0   00:09:24   3731      0
  1   00:02:45   1214      0   00:07:16   1412      0

cd /tmp
mkdir asdf-playground/ && cd asdf-playground/
mkdir foo/
echo '(defpackage :foo1)' > foo/foo1.lisp
echo '(defpackage :foo2)' > foo/foo2.lisp

(defclass auto-module (module) ())

(defmethod component-children ((self auto-module))
  (mapcar (lambda (p)
            (make-instance 'cl-source-file :type "lisp"
                           :pathname p
                           :name (pathname-name p)
                           :parent (component-parent self)))
          (directory-files (component-pathname self)
                           (make-pathname :directory nil :name *wild* :type "lisp"))))

(asdf:defsystem #:playground
  :components ((:auto-module "foo")))

* (pushnew '*default-pathname-defaults* asdf:*central-registry*)
(*DEFAULT-PATHNAME-DEFAULTS*)
* (asdf:load-system 'playground)
; compiling file "/private/tmp/asdf-playground/foo/foo1.lisp" (written 10 JAN 2022 10:54:31 AM):
; processing (DEFPACKAGE :FOO1)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo1-tmpGHU3ALSV.fasl
; compilation finished in 0:00:00.003
; compiling file "/private/tmp/asdf-playground/foo/foo2.lisp" (written 10 JAN 2022 10:54:33 AM):
; processing (DEFPACKAGE :FOO2)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo2-tmpAAURSO1.fasl
; compilation finished in 0:00:00.001
; compiling file "/private/tmp/asdf-playground/foo/foo1.lisp" (written 10 JAN 2022 10:54:31 AM):
; processing (DEFPACKAGE :FOO1)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo1-tmp5GEXGEG5.fasl
; compilation finished in 0:00:00.000
; compiling file "/private/tmp/asdf-playground/foo/foo2.lisp" (written 10 JAN 2022 10:54:33 AM):
; processing (DEFPACKAGE :FOO2)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo2-tmpAR3FSGEY.fasl
; compilation finished in 0:00:00.001
T

(defclass auto-module (module) ())

(defmethod component-children ((self auto-module))
  (mapcar (lambda (p)
            (make-instance 'cl-source-file :type "lisp"
                           :pathname p
                           :name (pathname-name p)
                           :parent (component-parent self)))
          (directory-files (component-pathname self)
                           (make-pathname :directory nil :name *wild* :type "lisp"))))

(asdf:defsystem #:playground
  :components ((:module "foo" :components ((:file "foo1") (:file "foo2")))))

* (asdf:load-system 'playground)
; compiling file "/private/tmp/asdf-playground/foo/foo1.lisp" (written 10 JAN 2022 10:54:31 AM):
; processing (DEFPACKAGE :FOO1)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo1-tmpGHU3ALSV.fasl
; compilation finished in 0:00:00.004
; compiling file "/private/tmp/asdf-playground/foo/foo2.lisp" (written 10 JAN 2022 10:54:33 AM):
; processing (DEFPACKAGE :FOO2)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo2-tmpAAURSO1.fasl
; compilation finished in 0:00:00.001
T

(defclass auto-module (module)
  ((file-cache :initform (make-hash-table))))

(defmethod component-children ((self auto-module)
                               &aux (file-cache (slot-value self 'file-cache)))
  (mapcar (lambda (p &aux (existing (gethash p file-cache)))
            (if existing
                existing
                (setf (gethash p file-cache)
                      (make-instance 'cl-source-file :type "lisp"
                                     :pathname p
                                     :name (pathname-name p)
                                     :parent (component-parent self)))))
          (directory-files (component-pathname self)
                           (make-pathname :directory nil :name *wild* :type "lisp"))))

(asdf:defsystem #:playground
  :components ((:auto-module "foo")))

* (asdf:load-system 'playground)
; compiling file "/private/tmp/asdf-playground/foo/foo1.lisp" (written 10 JAN 2022 10:54:31 AM):
; processing (DEFPACKAGE :FOO1)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo1-tmp5GEXGEG5.fasl
; compilation finished in 0:00:00.001
; compiling file "/private/tmp/asdf-playground/foo/foo2.lisp" (written 10 JAN 2022 10:54:33 AM):
; processing (DEFPACKAGE :FOO2)

; wrote /Users/matteolandi/.cache/common-lisp/sbcl-2.1.9-macosx-x64/private/tmp/asdf-playground/foo/foo2-tmpAR3FSGEY.fasl
; compilation finished in 0:00:00.001
T

(defun read-instructions (lines)
  (loop for string in lines collect
        (loop with start = 0 and value-read while (< start (length string))
              collect (setf (values value-read start)
                            (read-from-string string nil nil :start start)))))

(define-modify-macro execf (other op) exec)
(defun exec (rand1 rand2 rator)
  (list rator rand1 rand2))

> (exec 1 2 '+)
(+ 1 2)

> (exec 'x 'y '*)
(* x y)

(defun b= (n1 n2) (if (= n1 n2) 1 0))

> (let ((vars (make-array 4 :initial-element 0)))
    (labels ((offset (v) (ecase v (w 0) (x 1) (y 2) (z 3)))
             (value (v) (if (numberp v) v (aref vars (offset v)))))
      (loop for (cmd a b) in (read-instructions (uiop:read-file-lines "src/2021/day24.txt")) do
            (ecase cmd
              (inp (pr vars)
                   (setf (aref vars 0) 'w
                         (aref vars 1) 'x
                         (aref vars 2) 'y
                         (aref vars 3) 'z)
                   (setf (aref vars (offset a)) '?))
              (add (execf (aref vars (offset a)) (value b) '+))
              (mul (execf (aref vars (offset a)) (value b) '*))
              (div (execf (aref vars (offset a)) (value b) 'truncate))
              (mod (execf (aref vars (offset a)) (value b) 'mod))
              (eql (execf (aref vars (offset a)) (value b) 'b=))))))
#(0 0 0 0)
#(? #1=(B= (B= (+ (MOD (+ (* X 0) Z) 26) 10) ?) 0)
  #2=(* (+ (+ (* #3=(+ (* (+ (* Y 0) 25) #1#) 1) 0) ?) 12) #1#)
  (+ (* (TRUNCATE Z 1) #3#) #2#))
#(? #1=(B= (B= (+ (MOD (+ (* X 0) Z) 26) 10) ?) 0)
  #2=(* (+ (+ (* #3=(+ (* (+ (* Y 0) 25) #1#) 1) 0) ?) 10) #1#)
  (+ (* (TRUNCATE Z 1) #3#) #2#))
#(? #1=(B= (B= (+ (MOD (+ (* X 0) Z) 26) 12) ?) 0)
  #2=(* (+ (+ (* #3=(+ (* (+ (* Y 0) 25) #1#) 1) 0) ?) 8) #1#)
  (+ (* (TRUNCATE Z 1) #3#) #2#))
...

(defun exec (rand1 rand2 rator)
  (if (and (numberp rand1) (numberp rand2))
    (funcall rator rand1 rand2)
    (list rator rand1 rand2)))

(defun simplify (rator rand1 rand2)
  (case rator
    (* (cond ((or (eql rand1 0) (eql rand2 0)) 0)))))

#(0 0 0 0)
#(? #1=(B= (B= (+ (MOD (+ 0 Z) 26) 10) ?) 0) #2=(* (+ (+ 0 ?) 12) #1#)
  (+ (* (TRUNCATE Z 1) (+ (* (+ 0 25) #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD (+ 0 Z) 26) 10) ?) 0) #2=(* (+ (+ 0 ?) 10) #1#)
  (+ (* (TRUNCATE Z 1) (+ (* (+ 0 25) #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD (+ 0 Z) 26) 12) ?) 0) #2=(* (+ (+ 0 ?) 8) #1#)
  (+ (* (TRUNCATE Z 1) (+ (* (+ 0 25) #1#) 1)) #2#))
...

(defun simplify (rator rand1 rand2)
  (case rator
    (+ (cond ((eql rand1 0) rand2)))
    (* (cond ((eql rand2 0) 0)))
    (truncate (cond ((eql rand2 1) rand1)))))

#(0 0 0 0)
#(? #1=(B= (B= (+ (MOD Z 26) 10) ?) 0) #2=(* (+ ? 12) #1#)
  (+ (* Z (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) 10) ?) 0) #2=(* (+ ? 10) #1#)
  (+ (* Z (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) 12) ?) 0) #2=(* (+ ? 8) #1#)
  (+ (* Z (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) 11) ?) 0) #2=(* (+ ? 4) #1#)
  (+ (* Z (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) 0) ?) 0) #2=(* (+ ? 3) #1#)
  (+ (* (TRUNCATE Z 26) (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) 15) ?) 0) #2=(* (+ ? 10) #1#)
  (+ (* Z (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) 13) ?) 0) #2=(* (+ ? 6) #1#)
  (+ (* Z (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) -12) ?) 0) #2=(* (+ ? 13) #1#)
  (+ (* (TRUNCATE Z 26) (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) -15) ?) 0) #2=(* (+ ? 8) #1#)
  (+ (* (TRUNCATE Z 26) (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) -15) ?) 0) #2=(* (+ ? 1) #1#)
  (+ (* (TRUNCATE Z 26) (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) -4) ?) 0) #2=(* (+ ? 7) #1#)
  (+ (* (TRUNCATE Z 26) (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) 10) ?) 0) #2=(* (+ ? 6) #1#)
  (+ (* Z (+ (* 25 #1#) 1)) #2#))
#(? #1=(B= (B= (+ (MOD Z 26) -5) ?) 0) #2=(* (+ ? 9) #1#)
  (+ (* (TRUNCATE Z 26) (+ (* 25 #1#) 1)) #2#))

(defun read-monad (lines &aux
                         (instructions (read-instructions lines))
                         (vars (make-array 4 :initial-element 0)))
  (labels ((offset (v) (ecase v (w 0) (x 1) (y 2) (z 3)))
           (value (v) (if (numberp v) v (aref vars (offset v))))
           (compile-into-lambda (e) (compile nil (pr `(lambda (? z) ,e)))))
    (uiop:while-collecting (add)
      (loop for (cmd a b) in instructions do
        (ecase cmd
          (inp (unless (eql (aref vars (offset 'z)) 0)
                 (add (compile-into-lambda (aref vars (offset 'z)))))
               (setf (aref vars 0) 'w (aref vars 1) 'x
                     (aref vars 2) 'y (aref vars 3) 'z)
               (setf (aref vars (offset a)) '?))
          (add (execf (aref vars (offset a)) (value b) '+))
          (mul (execf (aref vars (offset a)) (value b) '*))
          (div (execf (aref vars (offset a)) (value b) 'truncate))
          (mod (execf (aref vars (offset a)) (value b) 'mod))
          (eql (execf (aref vars (offset a)) (value b) 'b=))))
      ;; Make sure to pick up all the 14 ALU stages
      (add (compile-into-lambda (aref vars (offset 'z)))))))

(defun first-valid-model (expressions &optional
                                      (input (iota 9 :start 9 :step -1))
                                      (z 0)
                                      &aux
                                      (remaining (length expressions)))
  (cond ((and (= remaining z 0)) 0)
        ((= remaining 0) nil)
        (t (loop for w in input for z-next = (funcall (car expressions) w z) do
                 (when-let (model (first-valid-model (rest expressions) input z-next))
                   (return (+ (* (expt 10 (1- remaining)) w) model)))))))

(defun first-valid-model (expressions &optional
                                      (input (iota 9 :start 9 :step -1))
                                      (z 0)
                                      (dp (make-hash-table))
                                      &aux
                                      (remaining (length expressions))
                                      (key (+ (* z 100) remaining)))
  (multiple-value-bind (model foundp) (gethash key dp)
    (if foundp
      model
      (setf (gethash key dp)
            (cond ((and (= remaining z 0)) 0)
                  ((= remaining 0) nil)
                  (t (loop for w in input for z-next = (funcall (car expressions) w z) do
                           (when-let (model (first-valid-model (rest expressions) input z-next dp))
                             (return (+ (* (expt 10 (1- remaining)) w) model))))))))))

> (time (first-valid-model (read-monad (uiop:read-file-lines "src/2021/day24.txt"))))
Evaluation took:
  2.168 seconds of real time
  2.104432 seconds of total run time (1.844197 user, 0.260235 system)
  [ Run times consist of 0.271 seconds GC time, and 1.834 seconds non-GC time. ]
  97.05% CPU
  350 lambdas converted
  4,986,893,536 processor cycles
  175,630,864 bytes consed

93959993429899

> (time (first-valid-model (read-monad (uiop:read-file-lines "src/2021/day24.txt"))
                           (iota 9 :start 1)))
Evaluation took:
  0.338 seconds of real time
  0.327866 seconds of total run time (0.311545 user, 0.016321 system)
  97.04% CPU
  350 lambdas converted
  778,391,119 processor cycles
  45,884,672 bytes consed

11815671117121

(define-solution (2021 24) (monad read-monad)
  (values (first-valid-model monad) (first-valid-model monad (iota 9 :start 1))))

> (time (test-run))
TEST-2021/24..
Success: 1 test, 2 checks.
Evaluation took:
  2.152 seconds of real time
  2.096319 seconds of total run time (2.027116 user, 0.069203 system)
  [ Run times consist of 0.036 seconds GC time, and 2.061 seconds non-GC time. ]
  97.40% CPU
  350 lambdas converted
  4,950,528,890 processor cycles
  204,097,808 bytes consed

#############
#...........#
###B#C#B#D###
  #A#D#C#A#
  #########

#############
#...........#
###A#B#C#D###
  #A#B#C#D#
  #########

(defun parse-input (lines &aux
                          (rows (length lines))
                          (cols (length (car lines)))
                          (burrow (make-array (list rows cols)
                                              :element-type 'character
                                              :initial-element #\Space))
                          rooms)
  (loop for row from 0 for string in lines do
        (loop for col from 0 for ch across string do
              (setf (aref burrow row col) ch)
              (when (and (< 1 row (1- rows)) (member col '(3 5 7 9)))
                (let* ((type (case col (3 #\A) (5 #\B) (7 #\C) (9 #\D)))
                       (existing (assoc type rooms)))
                  (if existing
                    (push (list row col) (second existing))
                    (push (list type (list (list row col))) rooms))))))
  (cons burrow rooms))
(defun siderooms (rooms type) (second (assoc type rooms)))

(defparameter *hallway* '((1 1) (1 2) (1 4) (1 6) (1 8) (1 10) (1 11)))

(defun organize (input &aux (burrow (car input)) (rooms (cdr input)))
  (search-cost
    (dijkstra burrow :test 'equalp :goalp (partial-1 #'donep rooms)
              :neighbors (partial-1 #'possible-moves rooms))))

(defun donep (rooms burrow)
  (loop for (type siderooms) in rooms always
        (loop for (row col) in siderooms
              always (char= (aref burrow row col) type))))

    ...
    (loop for (_ positions) in rooms do
          (loop for pos in positions for type = (aref burrow (car pos) (cadr pos))
            unless (or (char= type #\.)
                       (in-place-p (siderooms rooms type) burrow type pos)) do
            (loop for target in *hallway*
                  unless (blockedp burrow pos target) do (add-move type pos target))))
    ...

    ...
    (loop for pos in *hallway* for type = (aref burrow (car pos) (cadr pos))
          unless (char= type #\.) do
          (loop for target in (siderooms rooms type)
            unless (blockedp burrow pos target) do (add-move type pos target)
            always (eql (aref burrow (car target) (cadr target)) type))))
    ...

(defun possible-moves (rooms burrow &aux moves)
  (labels ((add-move (type pos target &aux
                           (next (copy-array burrow))
                           (cost (* (manhattan-distance pos target)
                                    (ecase type (#\A 1) (#\B 10) (#\C 100) (#\D 1000)))))
             (rotatef (aref next (car pos) (cadr pos))
                      (aref next (car target) (cadr target)))
             (push (cons next cost) moves)))
    ;; From the wrong sideroom to the hallway
    (loop for (_ positions) in rooms do
          (loop for pos in positions for type = (aref burrow (car pos) (cadr pos))
            unless (or (char= type #\.)
                       (in-place-p (siderooms rooms type) burrow pos)) do
            (loop for target in *hallway*
                  unless (blockedp burrow pos target) do (add-move type pos target))))
    ;; Fromt he hallway to the right sideroom
    (loop for pos in *hallway* for type = (aref burrow (car pos) (cadr pos))
          unless (char= type #\.) do
          (loop for target in (siderooms rooms type)
            unless (blockedp burrow pos target) do (add-move type pos target)
            always (eql (aref burrow (car target) (cadr target)) type)))
    moves))

(defun in-place-p (rooms burrow pos
                         &aux (type (aref burrow (car pos) (cadr pos))))
  (loop for r in (siderooms rooms type)
        thereis (equal r pos)
        ;; if not in the room, at least let's make sure the one below is
        ;; occupied by an amphipod of the right type
        always (eql (aref burrow (car r) (cadr r)) type)))

(defun blockedp (burrow pos target)
  (destructuring-bind (row1 col1) pos
    (destructuring-bind (row2 col2) target
      (let ((col-step (<=> col2 col1)))
        (flet ((check-all (row1 col1 row2 col2 row-step col-step)
                 (loop do (incf row1 row-step) (incf col1 col-step)
                       thereis (char/= (aref burrow row1 col1) #\.)
                       until (and (= row1 row2) (= col1 col2)))))
          (if (= row1 1)
            (or (check-all row1 col1 row1 col2 0 col-step)
                (check-all row1 col2 row2 col2 1 0))
            (or (check-all row1 col1 row2 col1 -1 0)
                (check-all row2 col1 row2 col2 0 col-step))))))))

> (organize (parse-input (uiop:read-file-lines "src/2021/day23.txt")))
18282

(defun massage (lines)
  (append
    (subseq lines 0 3)
    (list
      "  #D#C#B#A#"
      "  #D#B#A#C#")
    (subseq lines 3)))

(define-solution (2021 23) (lines)
  (values (organize (parse-input lines)) (organize (parse-input (massage lines)))))

(define-test (2021 23) (18282 50132))

> (time (test-run))
TEST-2021/23..
Success: 1 test, 2 checks.
Evaluation took:
  3.197 seconds of real time
  3.089562 seconds of total run time (2.924923 user, 0.164639 system)
  [ Run times consist of 0.134 seconds GC time, and 2.956 seconds non-GC time. ]
  96.65% CPU
  7,353,654,160 processor cycles
  249,187,888 bytes consed

Evaluation took:
  2742.203 seconds of real time
  2570.780518 seconds of total run time (2510.998329 user, 59.782189 system)
  [ Run times consist of 17.916 seconds GC time, and 2552.865 seconds non-GC time. ]
  93.75% CPU
  6,306,877,691,085 processor cycles
  130,990,228,720 bytes consed

50132

(defun heuristic (costs amphipods &aux by-type)
  (loop for (type) being the hash-values of amphipods using (hash-key pos)
        for existing = (assoc type by-type) do
        (if existing
          (push pos (second existing))
          (push (list type (list pos)) by-type)))
  (loop for (type (pos1 pos2 pos3 pos4)) in by-type for m = (cost type) sum
        (loop for (room1 room2 room3 room4) in (all-permutations (rooms type))
              minimize (* (+ (gethash (cons pos1 room1) costs)
                             (gethash (cons pos2 room2) costs)
                             #+#:part2 (gethash (cons pos3 room3) costs)
                             #+#:part2 (gethash (cons pos4 room4) costs))
                          m))))

(defun part1 (input &aux (opens (car input)) (amphipods (cdr input)))
  (multiple-value-bind (best cost path all-costs)
      (a* amphipods :test 'equalp :goalp #'donep
          :neighbors #'next
          :heuristic (partial-1 #'heuristic (calculate-all-costs opens)))
    cost))

(LAMBDA (#:MORE-ARG632)
  (FUNCALL #'HEURISTIC (CALCULATE-ALL-COSTS OPENS) #:MORE-ARG632))

> (time
    (loop with cost-so-far = (make-hash-table :test 'equalp)
          with come-from = (make-hash-table :test 'equalp)
          with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (gethash (list row col) burrow) (random 100))))
          repeat 10000 do
          (let ((next (copy-hash-table burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
            (setf (gethash next cost-so-far) (random 1000)
                  (gethash next come-from) burrow
                  burrow next))
          finally (return cost-so-far)))
Evaluation took:
  8.590 seconds of real time
  7.674754 seconds of total run time (7.435813 user, 0.238941 system)
  [ Run times consist of 0.117 seconds GC time, and 7.558 seconds non-GC time. ]
  89.35% CPU
  19,757,710,348 processor cycles
  4 page faults
  13,891,952 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9383 {1008D48DA3}>

> (time
    (loop with cost-so-far = (make-hash-table :test 'equalp)
          with come-from = (make-hash-table :test 'equalp)
          with rows = 2 and cols = 10 with burrow = (make-array (list rows cols))
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (aref burrow row col) (random 100))))
          repeat 10000 do
          (let ((next (copy-array burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (aref next row1 col1) (aref next row2 col2))
            (setf (gethash next cost-so-far) (random 1000)
                  (gethash next come-from) burrow
                  burrow next))
          finally (return cost-so-far)))
Evaluation took:
  0.016 seconds of real time
  0.016474 seconds of total run time (0.014154 user, 0.002320 system)
  100.00% CPU
  38,822,509 processor cycles
  4,955,568 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9472 {10053A5973}>

> (time
    (loop with cost-so-far = (make-hash-table :test 'equalp)
          with come-from = (make-hash-table :test 'equalp)
          with rows = 2 and cols = 10 and burrow = (make-hash-table :test 'equal)
          initially (loop for row below rows do
                          (loop for col below cols do
                                (setf (gethash (list row col) burrow) (random 100))))
          repeat 10000 do
          (let ((next (copy-hash-table burrow))
                (row1 (random rows)) (col1 (random cols))
                (row2 (random rows)) (col2 (random cols)))
            (rotatef (gethash (list row1 col1) next) (gethash (list row2 col2) next))
            (let ((state-key (uiop:while-collecting (add)
                               (loop for row below rows do
                                     (loop for col below cols do
                                           (add (gethash (list row col) next)))))))
              (setf (gethash state-key cost-so-far) (random 1000)
                    (gethash state-key come-from) burrow
                    burrow next)))
          finally (return cost-so-far)))
Evaluation took:
  0.082 seconds of real time
  0.079201 seconds of total run time (0.065240 user, 0.013961 system)
  96.34% CPU
  190,095,780 processor cycles
  26,703,456 bytes consed

#<HASH-TABLE :TEST EQUALP :COUNT 9370 {10073CA463}>

on x=10..12,y=10..12,z=10..12
on x=11..13,y=11..13,z=11..13
off x=9..11,y=9..11,z=9..11
on x=10..10,y=10..10,z=10..10

(defun parse-instructions (data)
  (mapcar #'parse-instruction data))
(defun parse-instruction (string)
  (cl-ppcre:register-groups-bind ((#'as-keyword state) (#'parse-integer x1 x2 y1 y2 z1 z2))
      ("(on|off) x=(-?\\d+)..(-?\\d+),y=(-?\\d+)..(-?\\d+),z=(-?\\d+)..(-?\\d+)" string)
    (list state (min x1 x2) (max x1 x2) (min y1 y2) (max y1 y2) (min z1 z2) (max z1 z2))))

(defun part1 (instructions &aux (cuboids (make-hash-table :test 'equal)))
  (loop for (state x1 x2 y1 y2 z1 z2) in instructions do
        (setf x1 (max x1 -50) x2 (min x2 50)
              y1 (max y1 -50) y2 (min y2 50)
              z1 (max z1 -50) z2 (min z2 50))
        (loop for x from x1 to x2 do
              (loop for y from y1 to y2 do
                    (loop for z from z1 to z2 do
                          (setf (gethash (list x y z) cuboids) state)))))
  (loop for state being the hash-values of cuboids count (eql state :on)))

(defun part2 (instructions &aux)
  (destructuring-bind (xx yy zz) (compress-coordinates instructions)
    (let ((grid (make-array (list (length xx) (length yy) (length zz))
                            :element-type 'bit
                            :initial-element 0)))
      (flet ((index-of (item vector &aux (start 0) (end (length vector)))
               (binary-search start end (partial-1 #'<=> (aref vector _) item))))
        (loop for (state x1 x2 y1 y2 z1 z2) in instructions
              for i-min = (index-of x1 xx) for i-max = (index-of (1+ x2) xx)
              for j-min = (index-of y1 yy) for j-max = (index-of (1+ y2) yy)
              for k-min = (index-of z1 zz) for k-max = (index-of (1+ z2) zz) do
              (loop for i from i-min below i-max do
                (loop for j from j-min below j-max do
                      (loop for k from k-min below k-max do
                            (setf (aref grid i j k) (ecase state (:on 1) (:off 0))))))))
      (loop with i-max = (1- (length xx)) and j-max = (1- (length yy)) and k-max = (1- (length zz))
            for i below i-max for x1 = (aref xx i) for x2 = (aref xx (1+ i)) sum
            (loop for j below j-max for y1 = (aref yy j) for y2 = (aref yy (1+ j)) sum
                  (loop for k below k-max for z1 = (aref zz k) for z2 = (aref zz (1+ k))
                        when (= (aref grid i j k) 1) sum (* (- x2 x1) (- y2 y1) (- z2 z1))))))))

(defun compress-coordinates (instructions)
  (flet ((unique&sorted (list &aux (list (remove-duplicates list)))
           (make-array (length list) :initial-contents (sort list #'<))))
    (loop for (_ x1 x2 y1 y2 z1 z2) in instructions
          collect x1 into xx collect (1+ x2) into xx
          collect y1 into yy collect (1+ y2) into yy
          collect z1 into zz collect (1+ z2) into zz
          finally (return (list (unique&sorted xx) (unique&sorted yy) (unique&sorted zz))))))

(define-solution (2021 22) (instructions parse-instructions)
  (values (part1 instructions) (part2 instructions)))

(define-test (2021 22) (570915 1268313839428137))

> (time (test-run))
TEST-2021/22..
Success: 1 test, 2 checks.
Evaluation took:
  14.835 seconds of real time
  13.695186 seconds of total run time (13.327857 user, 0.367329 system)
  [ Run times consist of 0.162 seconds GC time, and 13.534 seconds non-GC time. ]
  92.32% CPU
  34,120,998,148 processor cycles
  231,646,416 bytes consed

(defun part2 (instructions &aux)
  (destructuring-bind (xx yy zz) (compress-coordinates instructions)
    (let ((grid (make-array (list (length xx) (length yy) (length zz))
                            :element-type 'bit
                            :initial-element 0)))
      (flet ((index-of (item vector &aux (start 0) (end (length vector)))
               (binary-search start end (partial-1 #'<=> (aref vector _) item))))
        (time (loop for (state x1 x2 y1 y2 z1 z2) in instructions
                for i-min = (index-of x1 xx) for i-max = (index-of (1+ x2) xx)
                for j-min = (index-of y1 yy) for j-max = (index-of (1+ y2) yy)
                for k-min = (index-of z1 zz) for k-max = (index-of (1+ z2) zz) do
                (loop for i from i-min below i-max do
                      (loop for j from j-min below j-max do
                            (loop for k from k-min below k-max do
                                  (setf (aref grid i j k) (ecase state (:on 1) (:off 0)))))))))
      (time (loop for i below (1- (length xx)) for x1 = (aref xx i) for x2 = (aref xx (1+ i)) sum
                  (loop for j below (1- (length yy)) for y1 = (aref yy j) for y2 = (aref yy (1+ j)) sum
                        (loop for k below (1- (length zz)) for z1 = (aref zz k) for z2 = (aref zz (1+ k))
                              when (= (aref grid i j k) 1) sum (* (- x2 x1) (- y2 y1) (- z2 z1)))))))))

> (time (test-run))
TEST-2021/22
Evaluation took:
  4.088 seconds of real time
  3.189448 seconds of total run time (3.073847 user, 0.115601 system)
  [ Run times consist of 0.037 seconds GC time, and 3.153 seconds non-GC time. ]
  78.01% CPU
  9,402,713,194 processor cycles
  65,504 bytes consed

Evaluation took:
  10.920 seconds of real time
  9.741171 seconds of total run time (9.536960 user, 0.204211 system)
  89.20% CPU
  25,115,619,739 processor cycles
  416 bytes consed

..
Success: 1 test, 2 checks.
Evaluation took:
  15.704 seconds of real time
  13.589492 seconds of total run time (13.193504 user, 0.395988 system)
  [ Run times consist of 0.084 seconds GC time, and 13.506 seconds non-GC time. ]
  86.53% CPU
  36,120,260,013 processor cycles
  231,686,928 bytes consed

Player 1 starting position: 4
Player 2 starting position: 8

(defun parse-positions (data)
  (flet ((player-position (string)
           (cl-ppcre:register-groups-bind ((#'parse-integer pos))
               ("Player \\d+ starting position: (\\d+)" string)
             pos)))
    (cons (player-position (first data)) (player-position (second data)))))
(defun player1 (positions) (car positions))
(defun player2 (positions) (cdr positions))

(defun play (p1 p2 &optional (s1 0) (s2 0) (last-die 100) (roll-count 0)
                 &aux
                 (result (mod1 (+ (+ last-die 1) (+ last-die 2) (+ last-die 3)) 10))
                 (last-die (mod1 (+ last-die 3) 100))
                 (p1 (mod1 (+ p1 result) 10))
                 (s1 (+ s1 p1))
                 (roll-count (+ roll-count 3)))
  (if (>= s1 1000) (* s2 roll-count) (play p2 p1 s2 s1 last-die roll-count)))

(defun mod1 (n max)
  (loop while (> n max) do (decf n max))
  n)

(defun part2 (positions)
  (destructuring-bind (wc1 . wc2) (count-wins (player1 positions) (player2 positions))
    (max wc1 wc2)))

(defun count-wins (p1 p2 &optional (s1 0) (s2 0))
  (let ((wc1 0) (wc2 0))
    (loop for d1 from 1 to 3 do
          (loop for d2 from 1 to 3 do
                (loop for d3 from 1 to 3
                      for p1-next = (mod1 (+ p1 d1 d2 d3) 10)
                      for s1-next = (+ s1 p1-next) do
                      (if (>= s1-next 21)
                        (incf wc1)
                        (destructuring-bind (w2 . w1) (count-wins p2 p1-next s2 s1-next dp)
                          (incf wc1 w1)
                          (incf wc2 w2))))))
    (cons wc1 wc2)))

(defun count-wins (p1 p2
                      &optional (s1 0) (s2 0) (dp (make-hash-table :test 'equal))
                      &aux (key (list p1 s1 p2 s2)))
  (uiop:if-let (wins (gethash key dp))
    wins
    (setf (gethash key dp)
          (let ((wc1 0) (wc2 0))
            (loop for d1 from 1 to 3 do
                  (loop for d2 from 1 to 3 do
                        (loop for d3 from 1 to 3
                              for p1-next = (mod1 (+ p1 d1 d2 d3) 10)
                              for s1-next = (+ s1 p1-next) do
                              (if (>= s1-next 21)
                                (incf wc1)
                                (destructuring-bind (w2 . w1) (count-wins p2 p1-next s2 s1-next dp)
                                  (incf wc1 w1)
                                  (incf wc2 w2))))))
            (cons wc1 wc2)))))

(define-solution (2021 21) (positions parse-positions)
  (values (part1 positions) (part2 positions)))

(define-test (2021 21) (998088 306621346123766))

> (time (test-run))
TEST-2021/21..
Success: 1 test, 2 checks.
Evaluation took:
  0.066 seconds of real time
  0.064617 seconds of total run time (0.062712 user, 0.001905 system)
  98.48% CPU
  153,951,731 processor cycles
  20,318,160 bytes consed

; in: DEFUN COUNT-WINS
;     (LIST AOC/2021/21::P1 AOC/2021/21::P2 &OPTIONAL (AOC/2021/21::S1 0)
;           (AOC/2021/21::S2 0))
;
; caught WARNING:
;   undefined variable: COMMON-LISP:&OPTIONAL

;     (AOC/2021/21::S1 0)
;
; caught STYLE-WARNING:
;   undefined function: AOC/2021/21::S1

;     (AOC/2021/21::S2 0)
;
; caught STYLE-WARNING:
;   undefined function: AOC/2021/21::S2
;
; compilation unit finished
;   Undefined functions:
;     S1 S2
;   Undefined variable:
;     &OPTIONAL
;   caught 1 WARNING condition
;   caught 2 STYLE-WARNING conditions
WARNING: redefining AOC/2021/21::COUNT-WINS in DEFUN
WARNING: redefining AOC/2021/21::COUNT-WINS/CLEAR-MEMO in DEFUN
COUNT-WINS
COUNT-WINS/CLEAR-MEMO

(defmacro defun/memo (name args &body body)
  (expand-defun/memo name args body))


(defun expand-defun/memo (name args body)
  (let* ((memo (gensym  (mkstr name '-memo))))
    `(let ((,memo (make-hash-table :test 'equalp)))
      (values
        ,(expand-defun/memo-memoized-fun memo name args body)
        ,(expand-defun/memo-clear-memo-fun memo name)))))


(defun expand-defun/memo-memoized-fun (memo name args body)
  (with-gensyms (key result result-exists-p)
    `(defun ,name ,args
      (let ((,key (list ,@(expand-defun/memo-keyable-args args))))
        (multiple-value-bind (,result ,result-exists-p) (gethash ,key ,memo)
          (if ,result-exists-p
            ,result
            (setf (gethash ,key ,memo)
                  ,@body)))))))

(defun expand-defun/memo-keyable-args (args)
  (uiop:while-collecting (collect)
    (loop while args for a = (pop args) do
          (cond ((eq a '&optional) nil)
                ((eq a '&key) nil)
                ((eq a '&rest) (pop args))
                ((eq a '&aux) (return))
                ((consp a) (collect (car a)))
                (t (collect a))))))


(defun expand-defun/memo-clear-memo-fun (memo name)
  (let ((clear-memo-name (intern (mkstr name '/clear-memo))))
    `(defun ,clear-memo-name ()
      (clrhash ,memo))))

(defun/memo count-wins (p1 p2 &optional (s1 0) (s2 0))
  (let ((wc1 0) (wc2 0))
    (loop for d1 from 1 to 3 do
          (loop for d2 from 1 to 3 do
                (loop for d3 from 1 to 3
                      for p1-next = (mod1 (+ p1 d1 d2 d3) 10)
                      for s1-next = (+ s1 p1-next) do
                      (if (>= s1-next 21)
                        (incf wc1)
                        (destructuring-bind (w2 . w1) (count-wins p2 p1-next s2 s1-next)
                          (incf wc1 w1)
                          (incf wc2 w2))))))
    (cons wc1 wc2)))

..#.#..#####.#.#.#.###.##.....###.##.#..###.####..#####..#....#..#..##..###..######.###...####..#..#####..##..#.#####...##.#.#..#.##..#.#......#.###.######.###.####...#.##.##..#..#..#####.....#.#....###..#.##......#.....#..#..#..##..#...##.######.####.####.#.#...#.......#..#.#.#...####.##.#......#..#...##.#.##..#...##.#.##..###.#......#.#.......#.#.#.####.###.##...#.....####.#..#..#.##.#....##..#.####....##...##..#...#......#.#.......#.......##..####..#...#.#.#...##..#.#..###..#####........#..####......#..#

#..#.
#....
##..#
..#..
..###

(defun parse-input (data)
  (list (parse-enhancement-algorightm (first data)) (parse-image (cddr data))))

(defun parse-enhancement-algorightm (string)
  (map 'vector (partial-1 #'eql #\#) string))

(defun parse-image (data &aux (image (make-hash-table :test 'equal)))
  (loop for r below (length data)
        for string in data do
        (loop for c below (length string)
              for ch across string
              when (eql ch #\#) do (setf (gethash (list r c) image) t)))
  image)

(defun enhancement-algorithm (input) (first input))
(defun image (input) (second input))

(defun enhance-step (algo curr &aux
                          (next (make-hash-table :test 'equal))
                          (row-min (loop for (r _) being the hash-keys of curr minimize r))
                          (row-max (loop for (r _) being the hash-keys of curr maximize r))
                          (col-min (loop for (_ c) being the hash-keys of curr minimize c))
                          (col-max (loop for (_ c) being the hash-keys of curr maximize c)))
  (flet ((block-3x3 (pos)
           (mapcar (partial-1 #'gethash _ curr) (neighbors9 pos))))
    (loop for row from (- row-min 3) to (+ row-max 3) do
          (loop for col from (- col-min 3) to (+ col-max 3)
            for pos = (list row col)
            for i = (as-binary (block-3x3 pos)) do
            (setf (gethash pos next) (aref algo i)))))
  next)

(defparameter *nhood* '((-1 -1) (-1  0) (-1 1)
                        ( 0 -1) ( 0  0) ( 0 1)
                        ( 1 -1) ( 1  0) ( 1 1)))

(defun neighbors9 (pos)
  (loop for d in *nhood* collect (mapcar #'+ pos d)))

(defun as-binary (list &aux (number 0))
  (loop for ch in list for i from 8 downto 0 when ch do
        (setf number (dpb 1 (byte 1 i) number)))
  number)

(defun enhance (iterations input &aux (algo (enhancement-algorithm input)) (curr (image input)))
  (dotimes (_ iterations)
    (setf curr (enhance-step algo curr)))
  (loop for state being the hash-values of curr count state))

(defun enhance (iterations input &aux (algo (enhancement-algorithm input)) (curr (image input)))
  (dotimes (i iterations)
    (setf curr (enhance-step algo curr (oddp i))))
  (loop for state being the hash-values of curr count state))

(defun enhance-step (algo curr background-lit-p &aux
                          (next (make-hash-table :test 'equal))
                          (row-min (loop for (r _) being the hash-keys of curr minimize r))
                          (row-max (loop for (r _) being the hash-keys of curr maximize r))
                          (col-min (loop for (_ c) being the hash-keys of curr minimize c))
                          (col-max (loop for (_ c) being the hash-keys of curr maximize c)))
  (flet ((block-3x3 (pos)
           (mapcar (partial-1 #'gethash _ curr background-lit-p)
                   (neighbors9 pos))))
    (loop for row from (- row-min 3) to (+ row-max 3) do
          (loop for col from (- col-min 3) to (+ col-max 3)
            for pos = (list row col)
            for i = (as-binary (block-3x3 pos)) do
            (setf (gethash pos next) (aref algo i)))))
  next)

(define-solution (2021 20) (input parse-input)
  (values (enhance 2 input) (enhance 50 input)))

(define-test (2021 20) (5503 19156))

> (time (test-run))
TEST-2021/20..
Success: 1 test, 2 checks.
Evaluation took:
  8.300 seconds of real time
  7.358258 seconds of total run time (6.756652 user, 0.601606 system)
  [ Run times consist of 0.756 seconds GC time, and 6.603 seconds non-GC time. ]
  88.65% CPU
  19,090,743,941 processor cycles
  2,622,069,728 bytes consed

Evaluation took:
  124.405 seconds of real time
  92.907883 seconds of total run time (90.247127 user, 2.660756 system)
  [ Run times consist of 0.972 seconds GC time, and 91.936 seconds non-GC time. ]
  74.68% CPU
  286,124,018,756 processor cycles
  13,399,299,136 bytes consed

(defun parse-scanner (paragraph &aux (paragraph (cl-ppcre:split "\\n" paragraph)))
  (flet ((numbers (string)
           (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "-?\\d+" string))))
    (cons
      (first (numbers (first paragraph)))
      (mapcar #'numbers (rest paragraph)))))
(defun id (scn) (car scn))
(defun beacons (scn) (cdr scn))

(defun row (i m) (nth i m))
(defun col (j m) (loop for row in m collect (nth j row)))
(defun dot-product (v1 v2) (apply #'+ (mapcar #'* v1 v2)))
(defun invert (m) (transpose m))
(defun transpose (m) (loop for i below (length m) collect (col i m)))

; Coutertesy of: https://www.euclideanspace.com/maths/algebra/matrix/orthogonal/rotation/index.htm
(defparameter *rotate-90-x*
  '((1 0  0)
    (0 0 -1)
    (0 1  0)))
(defparameter *rotate-90-y*
  '(( 0 0 1)
    ( 0 1 0)
    (-1 0 0)))
(defparameter *rotate-90-z*
  '((0 -1 0)
    (1  0 0)
    (0  0 1)))

(defun m* (m1 m2)
  (loop for i below (length m1) collect
        (loop for j below (length (first m1)) collect
              (dot-product (row i m1) (col j m2)))))

(defun compute-all-rotation-matrices (&aux
                                       (midentity '((1 0 0) (0 1 0) (0 0 1)))
                                       rez)
  (loop repeat 4
        for rz = midentity then (m* rz *rotate-90-z*) do
        (loop repeat 4
              for ry = (m* rz midentity) then (m* ry *rotate-90-y*) do
              (loop repeat 4
                    for rx = (m* ry midentity) then (m* rx *rotate-90-x*) do
                    (push rx rez))))
  (reverse (remove-duplicates rez :test 'equal)))

(defparameter *all-rotation-natrices* (compute-all-rotation-matrices))

(defun find-beacons (scanners &aux
                       (queue (list (list (first scanners) '(0 0 0) '((1 0 0) (0 1 0) (0 0 1)))))
                       (rez (beacons (first scanners)))
                       (scanners (rest scanners)))
  (loop while queue
        for (scn1 d10 r10) = (pop queue) do
        (loop for scn2 in scanners do
              (multiple-value-bind (p1 r21) (locate-scanner scn1 scn2)
                (when p1
                  (flet ((transform21 (p2) (v+ (rotate p2 r21) p1))
                         (transform10 (p1) (v+ (rotate p1 r10) d10)))
                    (let ((d20 (transform10 p1))
                          (r20 (m* r10 r21)))
                      (prl (id scn1) d10 r10 (id scn2) p1 r21 d20 r20)
                      (setf rez (append rez (mapcar (lambda (p2)
                                                      (transform10 (transform21 p2)))
                                                    (beacons scn2)))
                        scanners (remove scn2 scanners :test 'equal)
                        queue (cons (list scn2 d20 r20) queue))))))))
  (remove-duplicates rez :test 'equal))


(defun locate-scanner (scn1 scn2 &aux (bb1 (beacons scn1)))
  (dolist (b1 bb1)
    (let ((dd1 (relative-to b1 bb1)))
      (dolist (m *all-rotation-natrices*)
        (let ((bb2 (rotate-all (beacons scn2) m)))
          (dolist (b2 bb2)
            (let ((dd2 (relative-to b2 bb2)))
              (let ((common (intersection dd1 dd2 :test 'equal)))
                (when (>= (length common) 12)
                  (let ((b2-orig (rotate b2 (invert m))))
                    (return-from locate-scanner
                                 (values (locate b1 b2-orig m) m))))))))))))

(defun relative-to (b bb) (mapcar (lambda (o) (mapcar #'- o b)) bb))
(defun rotate-all (points matrix) (mapcar (partial-1 #'rotate _ matrix) points))
(defun rotate (point matrix)
  (loop for row in matrix collect (dot-product row point)))
(defun locate (b1 b2 m) (v- b1 (rotate b2 m)))

#; DO IT!
(find-beacons (mapcar #'parse-scanner (cl-ppcre:split "\\n\\n" (uiop:read-file-string "src/2021/day19.txt"))))
(setq beacons *)
(length *)

(defun find-scanners (scanners &aux
                       (queue (list (list (first scanners) '(0 0 0) '((1 0 0) (0 1 0) (0 0 1)))))
                       rez
                       (scanners (rest scanners)))
  (loop while queue
        for (scn1 d10 r10) = (pop queue) do
        (loop for scn2 in scanners do
              (multiple-value-bind (p1 r21) (locate-scanner scn1 scn2)
                (when p1
                  (flet ((transform21 (p2) (v+ (rotate p2 r21) p1))
                         (transform10 (p1) (v+ (rotate p1 r10) d10)))
                    (let ((d20 (transform10 p1))
                          (r20 (m* r10 r21)))
                      (prl (id scn1) d10 r10 (id scn2) p1 r21 d20 r20)
                      (setf rez (cons d20 rez)
                        scanners (remove scn2 scanners :test 'equal)
                        queue (cons (list scn2 d20 r20) queue))))))))
  rez)

#; DO IT!
(find-scanners (mapcar #'parse-scanner (cl-ppcre:split "\\n\\n" (uiop:read-file-string "src/2021/day19.txt"))))
(setq scanners *)
(loop for (s1 . remaining) on scanners maximize
      (loop for s2 in remaining maximize (manhattan-distance s1 s2)))

(defun parse-snumbers (data) (mapcar #'sread data))

(defun sread (string)
  (flet ((ch->number (ch) (- (char-code ch) (char-code #\0))))
    (loop for ch across string
          unless (eql ch #\,) collect (if (find ch "[]") ch (ch->number ch)))))

> (sread "[[1,2],[3,4]]")
(#\[ #\[ 1 2 #\] #\[ 3 4 #\] #\])

(defun s+ (number1 number2)
  (sreduce (append
             (list #\[)
             number1
             number2
             (list #\]))))

(defun sreduce (number)
  (loop
    (uiop:if-let (exploded (sexplode number))
      (setf number exploded)
      (uiop:if-let (split (ssplit number))
        (setf number split)
        (return number)))))

(defun sexplode (number &aux (depth 0) to-the-left)
  (loop for (v . to-the-right) on number do
        (cond ((numberp v) (push v to-the-left))
              ((eql v #\]) (push v to-the-left) (decf depth))
              ((and (eql v #\[) (/= depth 4)) (push v to-the-left) (incf depth))
              (t (let ((left (pop to-the-right))
                       (right (pop to-the-right)))
                   (assert (and (eql v #\[) (= depth 4)))
                   (assert (eql (pop to-the-right) #\]))
                   (flet ((add-first (addend list)
                            (loop for (v . to-the-right) on list
                                  collect (if (numberp v) (+ v addend) v) into vv
                                  when (numberp v) append to-the-right into vv and return vv
                                  finally (return vv))))
                     (return
                       (append
                         (reverse (add-first left to-the-left))
                         (list 0)
                         (add-first right to-the-right)))))))))

(defun ssplit (number)
  (loop for (v . to-the-right) on number
        if (or (not (numberp v)) (< v 10)) collect v into to-the-left
        else return (append
                      to-the-left
                      (list #\[)
                      (list (floor v 2) (ceiling v 2))
                      (list #\])
                      to-the-right)))

(defun smagnitude (number &aux stack)
  (loop for (ch . remaining) on number do
        (case ch
          (#\[ (push ch stack))
          (#\] (let ((right (pop stack))
                     (left (pop stack)))
                 (assert (eql (pop stack) #\[))
                 (push (+ (* left 3) (* right 2)) stack)))
          (otherwise (push ch stack))))
  (pop stack))

(defun part1 (numbers) (smagnitude (reduce #'s+ numbers)))

(defun part2 (numbers)
  (loop for (n1 . remaining) on numbers maximize
        (loop for n2 in remaining
              maximize (smagnitude (s+ n1 n2))
              maximize (smagnitude (s+ n2 n1)))))

(define-solution (2021 18) (numbers parse-snumbers)
  (values (part1 numbers) (part2 numbers)))

(define-test (2021 18) (3987 4500))

> (time (test-run))
TEST-2021/18..
Success: 1 test, 2 checks.
Evaluation took:
  0.197 seconds of real time
  0.187851 seconds of total run time (0.179690 user, 0.008161 system)
  [ Run times consist of 0.020 seconds GC time, and 0.168 seconds non-GC time. ]
  95.43% CPU
  453,704,694 processor cycles
  403,829,360 bytes consed

(defstruct (probe (:conc-name) (:constructor %make-probe)) x y vx vy)

(defun make-probe (vx vy) (%make-probe :x 0 :y 0 :vx vx :vy vy))

(defun move (probe)
  (with-slots (x y vx vy) probe
    (let ((dx (<=> vx 0)))
      (incf x vx)
      (incf y vy)
      (decf vx dx)
      (decf vy)))
  probe)

target area: x=20..30, y=-10..-5

(defstruct (area (:conc-name) (:constructor %make-area)) x1 x2 y1 y2)

(defun make-area (x1 x2 y1 y2)
  (%make-area :x1 (min x1 x2) :x2 (max x1 x2)
              :y1 (min y1 y2) :y2 (max y1 y2)))

(defun parse-input (data)
  (flet ((parse (string)
           (cl-ppcre:register-groups-bind ((#'parse-integer x1 x2 y1 y2))
               ("target area: x=(-?\\d+)..(-?\\d+), y=(-?\\d+)..(-?\\d+)" string)
             (make-area x1 x2 y1 y2))))
    (parse (first data))))

(defun solve (target)
  (loop for vx from (vx-min target) to (vx-max target) maximize
        (loop for vy from (vy-min target) to (vy-max target)
              when (shoot target vx vy) maximize it)))

(defun shoot (target vx vy &aux (probe (make-probe vx vy)))
  (loop until (past-target-p target probe)
        when (on-target-p target probe) return y-max
        do (move probe)
        maximize (y probe) into y-max))

(defun past-target-p (target probe) (< (y probe) (y1 target)))

(defun on-target-p (target probe)
  (and (<= (x1 target) (x probe) (x2 target))
       (<= (y1 target) (y probe) (y2 target))))

(defun vx-max (target) (x2 target))

(defun vx-min (target &aux (x (x1 target)))
  (loop while (> x 0) for vx from 0 do (decf x vx) finally (return vx)))

(defun vy-max (target) (- (y1 target)))

(defun vy-min (target) (declare (ignore target)) 0)

> (solve (parse-input (uiop:read-file-lines "src/2021/day17.txt")))
5565

(defun solve (target &aux (part1 0) (part2 0))
  (loop for vx from (vx-min target) to (vx-max target) do
        (loop for vy from (vy-min target) to (vy-max target) do
              (uiop:if-let (highest (shoot target vx vy))
                (setf part1 (max part1 highest)
                      part2 (1+ part2)))))
  (values part1 part2))

(defun vy-min (target) (y1 target))

(define-solution (2021 17) (target parse-input) (solve target))

(define-test (2021 17) (5565 2118))

> (time (test-run))
TEST-2021/17..
Success: 1 test, 2 checks.
Evaluation took:
  0.338 seconds of real time
  0.307870 seconds of total run time (0.297925 user, 0.009945 system)
  91.12% CPU
  779,177,010 processor cycles
  1,669,536 bytes consed

(defun parse-input (data)
  (hexadecimal->binary (first data)))

(defun parse-input (data)
  (parse-packet (hexadecimal->binary (first data))))

(defun bin (s start &optional (end (length s)))
  (parse-integer s :start start :end end :radix 2))

(defun parse-literal (s &optional (start 0) &aux (literal 0))
  (loop
    (let ((morep (= (bin s start (incf start)) 1)))
      (setf literal (+ (* literal 16) (bin s start (incf start 4))))
      (unless morep (return (values literal start))))))

(defun parse-operator (s &optional (start 0) &aux pkts)
  (ecase (bin s start (incf start))
    (0 (let* ((remaining (bin s start (incf start 15))))
         (loop while (> remaining 3) do
               (multiple-value-bind (pkt consumed) (parse-packet s start)
                 (setf remaining (- remaining (- consumed start))
                       pkts (cons pkt pkts)
                       start consumed)))))
    (1 (dotimes (_ (bin s start (incf start 11)))
         (multiple-value-bind (pkt consumed) (parse-packet s start)
           (setf pkts (cons pkt pkts) start consumed)))))
  (values (reverse pkts) start))

(defun parse-packet (s &optional (start 0))
  (let ((version (bin s start (incf start 3)))
        (type (bin s start (incf start 3))))
    (multiple-value-bind (parsed start)
        (if (= type 4) (parse-literal s start) (parse-operator s start))
      (values (list :version version
                    :type type
                    :literal (if (= type 4) parsed)
                    :sub-packets (if (/= type 4) parsed))
              start))))

(defun part1 (pkt)
  (labels ((recur (pkt)
             (+ (getf pkt :version)
                (loop for next in (getf pkt :sub-packets)
                      sum (recur next)))))
    (recur pkt)))

(defun b> (a b) (if (> a b) 1 0))
(defun b< (a b) (if (< a b) 1 0))
(defun b= (a b) (if (= a b) 1 0))

(defun part2 (pkt)
  (labels ((recur (pkt &aux (literal (getf pkt :literal)))
             (cond (literal literal)
                   (t (apply
                        (aref #(+ * min max identity b> b< b=) (getf pkt :type))
                        (loop for next in (getf pkt :sub-packets)
                              collect (recur next)))))))
    (recur pkt)))

(define-solution (2021 16) (pkt parse-input)
  (part2 pkt))

(define-test (2021 16) (943 167737115857))

> (time (test-run))
TEST-2021/16..
Success: 1 test, 2 checks.
Evaluation took:
  0.002 seconds of real time
  0.002154 seconds of total run time (0.001430 user, 0.000724 system)
  100.00% CPU
  5,031,393 processor cycles
  1,062,096 bytes consed

> (defun part2 (pkt)
    (labels ((recur (pkt &aux (literal (getf pkt :literal)))
               (cond (literal literal)
                     (t (cons
                          (aref #(+ * min max identity b> b< b=) (getf pkt :type))
                          (loop for next in (getf pkt :children)
                                collect (recur next)))))))
      (recur pkt)))
PART2

> (part2 (parse-input (uiop:read-file-lines "src/2021/day16.txt")))
(+ (MIN 2479731930) 7 (* (B< 10381 100) 8) (* 188 242 135) (* 236 42)
   (MAX 57613) (* 189 (B> 2027 2269116)) (* 131 104 201 105 155)
   (* 2920854314 (B> (+ 6 3 7) (+ 13 3 15))) 6
   (* 2165 (B= (+ 14 8 5) (+ 2 15 7))) 38575271553
   (* (B< (+ 12 5 3) (+ 11 6 12)) 41379) (* (B> 727598 727598) 752530)
   (* 2939 (B< 1007934 660540)) (MAX 498405352 113 1358) (* 3146 (B> 5 5))
   17083744931 (* 11) (MIN 214 46980) 4 (MIN 1 25270 47 240)
   (MAX 247 45266 27 147874 49322) (* 45822 (B< 2491 2491)) 12
   (* (B= 129 1004426) 4030837) 2368 172 (MAX 186 479 31 225) (+ 62424214260)
   (* 3722699 (B= 232 232)) (* 220 (B< 3667 50625)) (+ 960 9)
   (+ 852362 59034 3 10186466 44654) (* (B> 33431 39079) 712787)
   (* 146 140 4 55) (+ 3682 248 76) (MAX 14 184) (MIN 2 1206 15 1476 5005)
   (MAX
    (*
     (+
      (MIN
       (+
        (+
         (+
          (MAX
           (MIN
            (MAX
             (MIN (MIN (+ (MIN (+ (MIN (+ (+ (MAX (* 2673))))))))))))))))))))
   (* 1343 (B> 38853 33177)) (* 119 (B< (+ 3 14 2) (+ 13 8 3)))
   (+ (* 4 5 7) (* 6 7 10) (* 11 3 3)) (+ 202 2004893107 2899 107)
   (* 901241660305 (B> (+ 4 4 8) (+ 13 6 3)))
   (* (+ 9 3 12) (+ 9 3 15) (+ 11 4 12)) (* (B= 217 40) 2513437316) 13
   (* 11 (B< 2706 2706)) (MIN 63 216 14909) (* (B< 3296 812743) 52657) 72078562
   (* (B> 144588154 652519) 5077920))

> (eval *)
167737115857

1163751742
1381373672
2136511328
3694931569
7463417111
1319128137
1359912421
3125421639
1293138521
2311944581

(defun parse-risk-levels (data &aux (levels (make-hash-table :test 'equal)))
  (loop for r below (length data)
        for string in data do
        (loop for c below (length string)
              for ch across string do
              (setf (gethash (list r c) levels)
                    (- (char-code ch) (char-code #\0)))))
  levels)

(defun lowest-risk (levels &aux
                           (row-max (loop for (r _) being the hash-keys of levels maximize r))
                           (col-max (loop for (_ c) being the hash-keys of levels maximize c))
                           (end (list row-max col-max)))
  (search-cost (a* '(0 0)
                   :goal-state end
                   :test 'equal
                   :neighbors (partial-1 #'neighbors levels)
                   :heuristic (partial-1 #'manhattan-distance end))))

(defparameter *nhood* '((-1 0) (0 1) (1 0) (0 -1)))

(defun neighbors (levels p)
  (loop for d in *nhood* for n = (mapcar #'+ p d)
        for level = (gethash n levels)
        when level collect (cons n level)))

(defun massage (levels &aux
                       (rows (1+ (loop for (r _) being the hash-keys of levels maximize r)))
                       (cols (1+ (loop for (_ c) being the hash-keys of levels maximize c)))
                       (rez (make-hash-table :test 'equal)))
  ;; Extend the map -- horizontally first
  (loop for (r c) being the hash-keys of levels using (hash-value risk) do
        (loop for i below 5
              for c1 = (+ c (* cols i))
              for risk1 = (+ risk (* 1 i)) do
              (setf (gethash (list r c1) rez) (if (> risk1 9) (- risk1 9) risk1))))
  ;; Then vertically
  (setf levels (copy-hash-table rez)) ;; copy because we are changing it as we scan it
  (loop for (r c) being the hash-keys of levels using (hash-value risk) do
        (loop for i below 5
              for r1 = (+ r (* rows i))
              for risk1 = (+ risk (* 1 i)) do
              (setf (gethash (list r1 c) rez) (if (> risk1 9) (- risk1 9) risk1))))
  rez)

(define-solution (2021 15) (risk-levels parse-risk-levels)
  (values (lowest-risk risk-levels) (lowest-risk (massage risk-levels))))

(define-test (2021 15) (745 3002))

> (time (test-run))
TEST-2021/15..
Success: 1 test, 2 checks.
Evaluation took:
  1.256 seconds of real time
  1.193335 seconds of total run time (1.131199 user, 0.062136 system)
  [ Run times consist of 0.097 seconds GC time, and 1.097 seconds non-GC time. ]
  94.98% CPU
  2,890,660,005 processor cycles
  206,780,240 bytes consed

      --------Part 1--------   --------Part 2--------
Day       Time   Rank  Score       Time   Rank  Score
 15   00:10:48    464      0   00:59:10   1927      0

NNCB

CH -> B
HH -> N
CB -> H
NH -> C
HB -> C
HC -> B
HN -> C
NN -> C
BH -> H
NC -> B
NB -> B
BN -> B
BB -> N
BC -> B
CC -> N
CN -> C

(defun parse-input (data)
  (list (coerce (first data) 'list)
        (parse-insertion-rules (cddr data))))

(defun parse-insertion-rules (data &aux (rules (make-hash-table :test 'equal)))
  (flet ((rule (string)
           (cl-ppcre:register-groups-bind (from to)
               ("(\\w+) -> (\\w)" string)
             (setf (gethash (coerce from 'list) rules) (coerce to 'list)))))
    (dolist (string data rules)
      (rule string))))

(defun evolve (times input &aux (polymer (first input)) (rules (second input)))
  (dotimes (_ times) (setf polymer (tick rules polymer)))
  (result polymer))

(defun tick (rules curr)
  (loop for (a b) on curr
        for (z) = (gethash (list a b) rules)
        if z collect a and collect z
        else collect a))

(defun result (polymer &aux (freqs (sort (frequencies polymer) #'< :key #'cdr)))
  (- (cdar (last freqs)) (cdar freqs)))

(defun evolve (times input &aux (polymer (first input)) (rules (second input)))
  (dotimes (i times)
    (setf polymer (tick rules polymer))
    (pr i (length polymer)))
  (result polymer))

> (evolve 20 (parse-input (uiop:read-file-lines "src/2021/day14.txt")))
0 39
1 77
2 153
3 305
4 609
5 1217
6 2433
7 4865
8 9729
9 19457
10 38913
11 77825
12 155649
13 311297
14 622593
15 1245185
16 2490369
17 4980737
18 9961473
19 19922945
8844255

(defun massage (input &aux (freqs (make-hash-table :test 'equal)))
  (destructuring-bind (template rules) input
    (loop for (a b) on template do (incf (gethash (list a b) freqs 0)))
    (list freqs rules)))

(defun tick (rules freqs &aux (next (make-hash-table :test 'equal)))
  (loop for (a b) being the hash-keys of freqs using (hash-value n)
        for (z) = (gethash (list a b) rules)
        if z do (incf (gethash (list a z) next 0) n) and do (incf (gethash (list z b) next 0) n)
        else do (incf (gethash (list a b) next 0) n))
  next)

(defun result (freqs &aux (ch-freqs (make-hash-table)))
  (loop for (a) being the hash-keys of freqs using (hash-value n) do
        (incf (gethash a ch-freqs 0) n))
  (- (loop for v being the hash-values of ch-freqs maximize v)
     (loop for v being the hash-values of ch-freqs minimize v)))

(define-solution (2021 14) (input parse-input)
  (let ((input (massage input)))
    (values (evolve 10 input) (evolve 40 input))))

(define-test (2021 14) (5656 12271437788530))

> (time (test-run))
TEST-2021/14..
Success: 1 test, 2 checks.
Evaluation took:
  0.012 seconds of real time
  0.004045 seconds of total run time (0.003179 user, 0.000866 system)
  33.33% CPU
  28,206,847 processor cycles
  976,656 bytes consed

6,10
0,14
9,10
0,3
10,4
4,11
6,0
6,12
4,1
0,13
10,12
3,4
3,0
8,4
1,10
2,14
8,10
9,0

fold along y=7
fold along x=5

(defun parse-input (data &aux
                         (dots (make-hash-table :test 'equal))
                         folds)
  (dolist (s data (list dots (reverse folds)))
    (when-let (point (parse-dot s))
      (setf (gethash point dots) t))
    (when-let (fold (parse-fold s))
      (push fold folds))))
(defun dots (data) (car data))
(defun folds (data) (cadr data))

(defun parse-dot (string)
  (cl-ppcre:register-groups-bind ((#'parse-integer col row))
      ("(\\d+),(\\d+)" string)
    (list row col)))

(defun parse-fold (string)
  (cl-ppcre:register-groups-bind ((#'as-keyword axis) (#'parse-integer n))
      ("fold along (\\w)=(\\d+)" string)
    (list axis n)))

(defun fold (input &aux (curr (dots input)))
  (dolist (f (folds input))
    (let ((next (make-hash-table :test 'equal)))
      (destructuring-bind (axis n) f
        (loop for (row col) being the hash-keys of curr do
              (ecase axis
                (:x (when (> col n) (decf col (* (- col n) 2))))
                (:y (when (> row n) (decf row (* (- row n) 2)))))
              (setf (gethash (list row col) next) t)))
      (setf curr next)
      (return-from fold (hash-table-count curr)))))

(defun fold (input &aux (curr (dots input)) part1)
  (dolist (f (folds input))
    (let ((next (make-hash-table :test 'equal)))
      (destructuring-bind (axis n) f
        (loop for (row col) being the hash-keys of curr do
              (ecase axis
                (:x (when (> col n) (decf col (* (- col n) 2))))
                (:y (when (> row n) (decf row (* (- row n) 2)))))
              (setf (gethash (list row col) next) t)))
      (setf curr next)
      (unless part1
        (setf part1 (hash-table-count curr)))))
  (values part1 (print-paper curr)))

(defun print-paper (dots &aux
                         (rows (loop for d being the hash-keys of dots maximize (car d)))
                         (cols (loop for d being the hash-keys of dots maximize (cadr d))))
  (with-output-to-string (s)
    (terpri s) ; print an additional newline, so I can better format the expected string
    (dotimes (row (1+ rows))
      (dotimes (col (1+ cols))
        (princ (if (gethash (list row col) dots) #\# #\Space) s))
      (terpri s))))

(define-solution (2021 13) (input parse-input) (fold input))

(define-test (2021 13) (724 "
 ##  ###    ## ###  #### ###  #  # #
#  # #  #    # #  # #    #  # #  # #
#    #  #    # ###  ###  #  # #  # #
#    ###     # #  # #    ###  #  # #
#  # #    #  # #  # #    # #  #  # #
 ##  #     ##  ###  #### #  #  ##  ####
"))

> (time (test-run))
TEST-2021/13..
Success: 1 test, 2 checks.
Evaluation took:
  0.022 seconds of real time
  0.011407 seconds of total run time (0.005706 user, 0.005701 system)
  50.00% CPU
  51,063,965 processor cycles
  1,038,608 bytes consed

    start
    /   \
c--A-----b--d
    \   /
     end

start-A
start-b
A-c
A-b
b-d
A-end
b-end

(defun parse-map (data &aux (map (make-hash-table)))
  (dolist (s data map)
    (destructuring-bind (from . to) (parse-line s)
      (push to (gethash from map))
      (push from (gethash to map)))))

(defun parse-line (string)
  (cl-ppcre:register-groups-bind ((#'make-keyword from to))
      ("(\\w+)-(\\w+)" string)
    (cons from to)))

(defun walk (map)
  (while-summing (path#)
    (labels ((recur (curr)
               (cond ((eq (car curr) :|end|) (path#))
                     (t (loop for next in (gethash (car curr) map)
                              when (or (big-cave-p next) (not (member next curr))) do
                              (recur (cons next curr)))))))
      (recur '(:|start|)))))

(defun visitablep (path next) (or (big-cave-p next) (not (member next path))))
(defun big-cave-p (cave) (not (small-cave-p cave)))
(defun small-cave-p (cave) (loop for ch across (string cave) thereis (lower-case-p ch)))

(defun part2-visitable-p (path next)
  (cond ((big-cave-p next) t)
        ((eq next :|start|) nil)
        (t (<= (loop for p on (cons next path) for (c) = p
                     when (small-cave-p c) count (> (count c p) 1))
               1))))

(defun walk (map &optional (visitablep #'visitablep))
  (while-summing (path#)
    (labels ((recur (path)
               (cond ((eq (car path) :|end|) (path#))
                     (t (loop for next in (gethash (car path) map)
                              when (visitablep path next) do
                              (recur (cons next path)))))))
      (recur '(:|start|)))))

(define-solution (2021 12) (map parse-map)
  (values (walk map) (walk map #'part2-visitable-p)))

(define-test (2021 12) (3000 74222))

> (time (test-run))
TEST-2021/12..
Success: 1 test, 2 checks.
Evaluation took:
  1.981 seconds of real time
  1.867072 seconds of total run time (1.818760 user, 0.048312 system)
  [ Run times consist of 0.007 seconds GC time, and 1.861 seconds non-GC time. ]
  94.25% CPU
  4,557,591,987 processor cycles
  29,753,344 bytes consed

(defmacro while-summing (summers &body body)
  (expand-while-summing summers body))

(defun expand-while-summing (summers body)
  (let* ((gen-syms (mapcar #'expand-while-summing-gensym summers))
         (let-bindings (mapcar #'expand-while-summing-let-binding gen-syms))
         (flet-bindings (mapcar #'expand-while-summing-flet-binding summers gen-syms)))
    `(let* (,@let-bindings)
      (flet (,@flet-bindings)
        ,@body
        (values ,@gen-syms)))))

(defun expand-while-summing-gensym (name) (gensym (string name)))

(defun expand-while-summing-let-binding (gensym) (list gensym 0))

(defun expand-while-summing-flet-binding (name binding)
  `(,name (&optional (delta 1))
    (incf ,binding delta)))

5483143223
2745854711
5264556173
6141336146
6357385478
4167524645
2176841721
6882881134
4846848554
5283751526

Before any steps:
11111
19991
19191
19991
11111

After step 1:
34543
40004
50005
40004
34543

After step 2:
45654
51115
61116
51115
45654

(defun parse-octopuses (data &aux (octopuses (make-hash-table :test 'equal)))
  (loop for r below (length data)
        for string in data do
        (loop for c below (length string)
              for ch across string do
              (setf (gethash (list r c) octopuses)
                    (- (char-code ch) (char-code #\0)))))
  octopuses)

(defun flash-dance (octopuses &aux (octopuses (copy-hash-table octopuses)))
  (loop repeat 100 sum (dance octopuses)))

(defun dance (curr &aux remaining (flashed (make-hset nil :test 'equal)))
  (flet ((flashesp (energy) (> energy 9))
         (flash (p)
           (hset-add p flashed)
           (setf remaining (append (neighbors curr p) remaining))))
    (loop for p being the hash-keys of curr
          when (flashesp (incf (gethash p curr))) do (flash p))
    (loop while remaining
          for n = (pop remaining)
          unless (hset-contains-p n flashed)
          when (flashesp (incf (gethash n curr))) do (flash n))
    (loop for p being the hash-keys of curr using (hash-value e)
          count (when (flashesp e) (setf (gethash p curr) 0)))))

(defparameter *nhood* '((-1 0) (-1 1) (0 1) (1 1) (1 0) (1 -1) (0 -1) (-1 -1)))

(defun neighbors (energies p)
  (loop for d in *nhood* for n = (mapcar #'+ p d)
        when (gethash n energies) collect n))

(defun flash-dance (octopuses &aux
                              (octopuses (copy-hash-table octopuses))
                              (part1 0))
  (loop for step from 1 for flashes = (dance octopuses)
        sum flashes into flash-count
        when (= step 100) do (setf part1 flash-count)
        when (= flashes 100) return (values part1 step)))

(define-solution (2021 11) (octopuses parse-octopuses) (flash-dance octopuses))

(define-test (2021 11) (1665 235))

> (time (test-run))
TEST-2021/11..
Success: 1 test, 2 checks.
Evaluation took:
  0.026 seconds of real time
  0.026022 seconds of total run time (0.022644 user, 0.003378 system)
  [ Run times consist of 0.011 seconds GC time, and 0.016 seconds non-GC time. ]
  100.00% CPU
  59,922,835 processor cycles
  2,554,240 bytes consed

(defparameter *closing*
  '((#\( . #\))
    (#\[ . #\])
    (#\{ . #\})
    (#\< . #\>)))

(defun syntax-scoring (file &aux (error-score 0))
  (dolist (line file)
    (let (stack)
      (loop for ch across line do
            (cond ((find ch "([{<") (push (cdr (assoc ch *closing*)) stack))
                  ((eq ch (car stack)) (pop stack))
                  (t (return (incf error-score (syntax-error-score ch))))))))
  error-score))

(defparameter *syntax-error-table*
  '((#\) . 3)
    (#\] . 57)
    (#\} . 1197)
    (#\> . 25137)))

(defun syntax-error-score (ch) (cdr (assoc ch *syntax-error-table*)))

(defun syntax-scoring (file &aux (error-score 0) completion-scores)
  (dolist (line file)
    (let (stack)
      (loop for ch across line do
            (cond ((find ch "([{<") (push (cdr (assoc ch *closing*)) stack))
                  ((eq ch (car stack)) (pop stack))
                  (t (return (incf error-score (syntax-error-score ch)))))
            finally (when stack
                      (push (completion-score stack) completion-scores)))))
  (values
    error-score
    (let* ((completion-scores (sort completion-scores #'<))
           (n (floor (length completion-scores) 2)))
      (nth n completion-scores))))

(defparameter *point-value-table*
  '((#\) . 1)
    (#\] . 2)
    (#\} . 3)
    (#\> . 4)))

(defun completion-score (stack &aux (score 0))
  (dolist (ch stack score)
    (setf score (+ (* score 5) (cdr (assoc ch *point-value-table*))))))

(define-solution (2021 10) (data) (syntax-scoring data))

(define-test (2021 10) (323613 3103006161))

> (time (test-run))
TEST-2021/10..
Success: 1 test, 2 checks.
Evaluation took:
  0.000 seconds of real time
  0.000799 seconds of total run time (0.000505 user, 0.000294 system)
  100.00% CPU
  1,872,677 processor cycles
  97,968 bytes consed

(defun parse-heights (data &aux (heights (make-hash-table :test 'equal)))
  (loop for r below (length data)
        for string in data do
        (loop for c below (length string)
              for ch across string do
              (setf (gethash (list r c) heights)
                    (- (char-code ch) (char-code #\0)))))
  heights)

(defun part1 (heights)
  (loop for p in (low-points heights) sum (1+ (gethash p heights))))

(defun low-points (heights)
  (loop for p being the hash-keys of heights using (hash-value h)
        when (every (lambda (n) (< h (gethash n heights))) (neighbors heights p))
        collect p))

(defparameter *nhood* '((-1 0) (0 1) (1 0) (0 -1)))

(defun neighbors (heights p)
  (loop for d in *nhood* for n = (mapcar #'+ p d)
        when (gethash n heights) collect n))

(defun part2 (heights)
  (reduce #'* (subseq (sort (basins heights) #'>) 0 3)))

(defun basins (heights)
  (uiop:while-collecting (acc!)
    (dolist (lp (low-points heights))
      (let ((size 0))
        (bfs lp :test 'equal :neighbors (lambda (p)
                                          (incf size)
                                          (remove-if-not (lambda (n)
                                                           (< (gethash n heights) 9))
                                                         (neighbors heights p))))
        (acc! size)))))

(define-solution (2021 09) (heights parse-heights)
  (values (part1 heights) (part2 heights)))

(define-test (2021 09) (502 1330560))

> (time (test-run))
TEST-2021/09..
Success: 1 test, 2 checks.
Evaluation took:
  0.050 seconds of real time
  0.046314 seconds of total run time (0.035313 user, 0.011001 system)
  92.00% CPU
  116,896,357 processor cycles
  9,133,328 bytes consed

(defun basins (heights &aux
                       (basins (make-hash-table :test 'equal))
                       (sizes (make-hash-table :test 'eq)))
  (loop for p being the hash-keys of heights using (hash-value h)
        unless (= h 9) do (setf (gethash p basins) (make-dset h)))
  (loop for p being the hash-keys of basins using (hash-value ds) do
        (loop for np in (neighbors heights p)
              for nds = (gethash np basins)
              when nds do (dset-union ds nds)))
  (loop for ds being the hash-values of basins do (incf (gethash (dset:dset-find ds) sizes 0)))
  (hash-table-values sizes))

> (time (test-run))
TEST-2021/09..
Success: 1 test, 2 checks.
Evaluation took:
  0.021 seconds of real time
  0.020646 seconds of total run time (0.017324 user, 0.003322 system)
  100.00% CPU
  49,747,608 processor cycles
  6,147,472 bytes consed

  0:      1:      2:      3:      4:
 aaaa    ....    aaaa    aaaa    ....
b    c  .    c  .    c  .    c  b    c
b    c  .    c  .    c  .    c  b    c
 ....    ....    dddd    dddd    dddd
e    f  .    f  e    .  .    f  .    f
e    f  .    f  e    .  .    f  .    f
 gggg    ....    gggg    gggg    ....

  5:      6:      7:      8:      9:
 aaaa    aaaa    aaaa    aaaa    aaaa
b    .  b    .  .    c  b    c  b    c
b    .  b    .  .    c  b    c  b    c
 dddd    dddd    ....    dddd    dddd
.    f  e    f  .    f  e    f  .    f
.    f  e    f  .    f  e    f  .    f
 gggg    gggg    ....    gggg    gggg

acedgfb cdfbe gcdfa fbcad dab cefabd cdfgeb eafb cagedb ab | cdfeb fcadb cdfeb cdbaf

(defun parse-entries (data)
  (loop for string in data
        for parts = (cl-ppcre:all-matches-as-strings "[a-z]+" string)
        collect (cons (subseq parts 0 10) (subseq parts 10))))
(defun inputs (entry) (car entry))
(defun outputs (entry) (cdr entry))

(defun part1 (entries)
  (loop for e in entries sum
        (loop for d in (outputs e) count (member (length d) '(2 4 3 7)))))

 dddd
e    a
e    a
 ffff
g    b
g    b
 cccc

(defun decode (mapping signals &aux (rez 0))
  (dolist (s signals)
    (let ((d (signal->digit mapping s)))
      (setf rez (+ (* rez 10) d))))
  rez)

(defparameter *digits->segments* '((0 . #b1110111)
                                   (1 . #b0100100)
                                   (2 . #b1011101)
                                   (3 . #b1101101)
                                   (4 . #b0101110)
                                   (5 . #b1101011)
                                   (6 . #b1111011)
                                   (7 . #b0100101)
                                   (8 . #b1111111)
                                   (9 . #b1101111)))

(defun signal->digit (mapping s &aux (segments-mask 0))
  (dovector (ch s)
    (let ((i (position ch mapping)))
      (setf segments-mask (dpb 1 (byte 1 i) segments-mask))))
  (car (rassoc segments-mask *digits->segments*)))


> (decode '(#\d #\e #\a #\f #\g #\b #\c) '("cdfeb" "fcadb" "cdfeb" "cdbaf"))
5353

(defun part2 (entries)
  (loop for e in entries for m = (find-mapping (inputs e))
        sum (decode m (outputs e))))

0 -> abcdefg
1 -> abcdefg
2 -> abcdefg
3 -> abcdefg
4 -> abcdefg
5 -> abcdefg
6 -> abcdefg
7 -> abcdefg

(defun find-mapping (signals)
  (labels ((recur (curr remaining)
             (cond ((loop for x in curr always (= (length x) 1))
                    (return-from find-mapping (mapcar #'car curr)))
                   ((loop for x in curr thereis (zerop (length x))) nil)
                   ((null remaining) nil)
                   (t (let ((s (first remaining)))
                        (dolist (d (possible-digits s))
                          (let ((segs (cdr (assoc d *digits->segments*))))
                            (recur
                              (loop for c in curr for i below 7
                                    collect (if (= (ldb (byte 1 i) segs) 1)
                                              (intersection c (coerce s 'list))
                                              (set-difference c (coerce s 'list))))
                              (rest remaining)))))))))
    (recur
      (loop repeat 7 collect (coerce "abcdefg" 'list))
      (sort (copy-seq signals) #'possible-digits<))))

(defparameter *length->digits* '((2 1)
                                 (3 7)
                                 (4 4)
                                 (5 2 3 5)
                                 (6 0 6 9)
                                 (7 8)))
(defun possible-digits (s) (cdr (assoc (length s) *length->digits*)))

(defun possible-digits< (s1 s2)
  (< (length (possible-digits s1)) (length (possible-digits s2))))

(define-solution (2021 08) (entries parse-entries)
  (values (part1 entries) (part2 entries)))

(define-test (2021 08) (330 1010472))

> (time (test-run))
TEST-2021/08..
Success: 1 test, 2 checks.
Evaluation took:
  0.005 seconds of real time
  0.005222 seconds of total run time (0.004867 user, 0.000355 system)
  100.00% CPU
  13,017,280 processor cycles
  2,160,512 bytes consed

> (time
    (let ((all-mappings (all-permutations (coerce "abcdefg" 'list)))
          (sum 0))
      (dolist (e (parse-entries (uiop:read-file-lines "src/2021/day08.txt")))
        (dolist (m all-mappings)
          (when (every (partial-1 #'signal->digit m) (inputs e))
            (return (incf sum (decode m (outputs e)))))))
      sum))
Evaluation took:
  0.384 seconds of real time
  0.370098 seconds of total run time (0.362925 user, 0.007173 system)
  96.35% CPU
  884,284,986 processor cycles
  2,194,816 bytes consed

1010472

(defun parse-crabs (data)
  (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "\\d+" (first data))))

(defun minimize-fuel (crabs)
  (loop for p from (find-min crabs) to (find-max crabs) minimize
        (loop for c in crabs sum (abs (- c p)))))

(defun minimize-fuel (crabs)
  (loop for p from (find-min crabs) to (find-max crabs) minimize
        (loop for c in crabs sum (let ((n (abs (- p1 p2))))
                                   (floor (* n (1+ n)) 2)))))

(defun minimize-fuel (crabs distance-fun)
  (loop for p from (find-min crabs) to (find-max crabs) minimize
        (loop for c in crabs sum (funcall distance-fun c p))))

(define-solution (2021 07) (crabs parse-crabs)
  (values (minimize-fuel crabs (lambda (p1 p2) (abs (- p1 p2))))
          (minimize-fuel crabs (lambda (p1 p2 &aux (n (abs (- p1 p2))))
                                 (floor (* n (1+ n)) 2)))))

(define-test (2021 07) (359648 100727924))

> (time (test-run))
TEST-2021/07..
Success: 1 test, 2 checks.
Evaluation took:
  0.093 seconds of real time
  0.083847 seconds of total run time (0.081319 user, 0.002528 system)
  90.32% CPU
  215,462,807 processor cycles
  96,608 bytes consed

> (time (loop for p from (find-min crabs) to (find-max crabs) minimize
              (loop for c in crabs sum
                    (loop repeat (- (max c p) (min c p))
                              for f from 1 sum c))))
Evaluation took:
  18.734 seconds of real time
  10.576204 seconds of total run time (10.243097 user, 0.333107 system)
  56.45% CPU
  43,088,527,879 processor cycles
  16 bytes consed

185638080

(defun parse-ages (data)
  (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "\\d" (first data))))

(defun part1 (ages)
  (let ((an (copy-seq ages)))
    (dotimes (_ 80 (length an))
      (setf an (uiop:while-collecting (next)
                 (dolist (a an)
                   (cond ((= a 0) (next 6) (next 8))
                         (t (next (1- a))))))))))

(defun parse-generations (data &aux
                               (generations (make-array 9 :initial-element 0))
                               (ages (cl-ppcre:all-matches-as-strings "\\d" (first data))))
  (loop for v in ages do (incf (aref generations (parse-integer v))))
  generations)

(defun evolve (generations days &aux (gg (copy-seq generations)))
  (dotimes (_ days (reduce #'+ gg))
    (let ((n (aref gg 0)))
      (dotimes (i 8)
        (setf (aref gg i) (aref gg (1+ i))))
      (setf (aref gg 8) n)
      (incf (aref gg 6) n))))

(define-solution (2021 06) (generations parse-generations)
  (values (evolve generations 80) (evolve generations 256)))

(define-test (2021 06) (371379 1674303997472))

> (time (test-run))
TEST-2021/06..
Success: 1 test, 2 checks.
Evaluation took:
  0.000 seconds of real time
  0.000528 seconds of total run time (0.000354 user, 0.000174 system)
  100.00% CPU
  1,277,524 processor cycles
  32,768 bytes consed

0,9 -> 5,9
8,0 -> 0,8
9,4 -> 3,4
2,2 -> 2,1
7,0 -> 7,4
6,4 -> 2,0
0,9 -> 2,9
3,4 -> 1,4
0,0 -> 8,8
5,5 -> 8,2

(defun parse-lines (data)
  (mapcar #'parse-line data))

(defun parse-line (string)
  (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "\\d+" string)))

(defun part1 (lines)
  (count-overlaps (remove-if #'diagonalp lines)))

(defun diagonalp (line)
  (destructuring-bind (x1 y1 x2 y2) line
    (and (not (= x1 x2)) (not (= y1 y2)))))

(defun count-overlaps (lines &optional (grid (make-hash-table :test 'equal)))
  (dolist (l lines)
    (destructuring-bind (x1 y1 x2 y2) l
      (let ((dx (<=> x2 x1))
            (dy (<=> y2 y1))
            (n (max (abs (- x2 x1)) (abs (- y2 y1)))))
        (loop repeat (1+ n)
              for xx = x1 then (+ xx dx)
              for yy = y1 then (+ yy dy) do
              (incf (gethash (list xx yy) grid 0))))))
  (loop for o being the hash-values of grid count (> o 1)))

(defun part2 (lines) (count-overlaps lines))

(define-solution (2021 05) (lines parse-lines)
  (values (part1 lines) (part2 lines)))

(define-test (2021 05) (6397 22335))

> (time (test-run))
TEST-2015/05..
Success: 1 test, 2 checks.
Evaluation took:
  0.155 seconds of real time
  0.131351 seconds of total run time (0.107549 user, 0.023802 system)
  84.52% CPU
  356,617,473 processor cycles
  44,400,176 bytes consed

;; Part 1
(loop with grid = (make-hash-table :test 'equal)
      for line in input for (x1 y1 x2 y2) = line
      when (or (= x1 x2) (= y1 y2)) do
      (loop for xx from (min x1 x2) to (max x1 x2) do
            (loop for yy from (min y1 y2) to (max y1 y2) do (incf (gethash (list xx yy) grid 0))))
      finally (return (loop for v being the hash-values of grid count (> v 1))))

;; Part 2
(loop with grid = (make-hash-table :test 'equal)
      for line in input for (x1 y1 x2 y2) = line do
      (loop for xx in (range x1 x2)
            for yy in (range y1 y2) do
            (incf (gethash (list xx yy) grid 0)))
      finally (return (count-if (partial-1 #'> _ 1) (hash-table-values grid))))

(defun range (v1 v2)
  (cond ((= v1 v2) (ncycle (list v1)))
        ((< v1 v2) (loop for v from v1 to v2 collect v))
        (t         (loop for v from v1 downto v2 collect v))))

      --------Part 1--------   --------Part 2--------
Day       Time   Rank  Score       Time   Rank  Score
  5   07:28:10  27193      0   07:41:09  24111      0
  4   00:30:52   2716      0   00:41:34   2704      0
  3   00:12:42   4249      0   00:48:51   5251      0
  2   00:05:42   3791      0   00:09:24   3731      0
  1   00:02:45   1214      0   00:07:16   1412      0

7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1

22 13 17 11  0
 8  2 23  4 24
21  9 14 16  7
 6 10  3 18  5
 1 12 20 15 19

 3 15  0  2 22
 9 18 13 17  5
19  8  7 25 23
20 11 10 24  4
14 21 16 12  6

14 21 17 24  4
10 16 15  9 19
18  8 23 26 20
22 11 13  6  5
 2  0 12  3  7

(defstruct (bingo (:conc-name nil))
  to-draw
  boards)

(defun parse-bingo (data)
  (let ((to-draw (extract-integers (car data)))
        (boards (parse-boards (cdr data))))
    (make-bingo :to-draw to-draw :boards boards)))

(defun parse-boards (data)
  (when data
    (cons
      (make-array '(5 5)
                  :initial-contents
                  (let ((lines (subseq data 1 6)))
                    (uiop:while-collecting (rows)
                      (dolist (s lines)
                        (let ((row (extract-integers s)))
                          (rows row))))))
      (parse-boards (subseq data 6)))))

(defun extract-integers (s)
  (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "\\d+" s)))

(defun play (game)
  (with-slots (to-draw boards) game
    (dolist (n to-draw)
      (dolist (b boards)
        (when (mark-number b n)
          (return-from play (* (board-score b) n)))))))

(defun mark-number (board n)
  (loop for i below 5 do
        (loop for j below 5
              when (eql (aref board i j) n) do
              (setf (aref board i j) nil)
              (return-from mark-number (board-won-p board i j)))))

(defun board-won-p (board last-marked-i last-marked-j)
  (or (loop for i below 5 never (aref board i last-marked-j))
      (loop for j below 5 never (aref board last-marked-i j))))

(defun score (board)
  (loop for i below 25 for v = (row-major-aref board i) when v sum v))

(defun play (game)
  (uiop:while-collecting (scores)
    (with-slots (to-draw boards) game
      (dolist (n to-draw)
        (dolist (b boards)
          (when (mark-number b n)
            (scores (* (score b) n))
            (setf boards (remove b boards))))))))

(define-solution (2021 04) (game parse-bingo)
  (let ((scores (play game)))
    (values (first scores) (car (last scores)))))

(define-test (2021 04) (82440 20774))

> (time (test-run))
TEST-2015/04..
Success: 1 test, 2 checks.
Evaluation took:
  0.006 seconds of real time
  0.005100 seconds of total run time (0.004883 user, 0.000217 system)
  83.33% CPU
  15,920,633 processor cycles
  851,856 bytes consed

(defun part1 (strings)
  (let* ((gamma (gamma-rate strings))
         (epsilon (map 'string #'ch-complement gamma)))
    (* (parse-binary gamma) (parse-binary epsilon))))

(defun ch-complement (ch) (if (eq ch #\1) #\0 #\1))

(defun parse-binary (s) (parse-integer s :radix 2))

(defun gamma-rate (strings &aux (n (length (first strings))))
  (coerce
    (uiop:while-collecting (bit!)
      (dotimes (i n)
        (bit! (most-common-ch-at strings i))))
    'string))

(defun most-common-ch-at (strings i)
  (loop for s in strings for ch = (aref s i)
        count (eq ch #\1) into ones
        finally (return (if (>= ones (/ (length strings) 2)) #\1 #\0))))

(defun part2 (strings)
  (* (oxygen-generator-rating strings) (co2-scrubber-rating strings)))

(defun oxygen-generator-rating (strings &optional (n (length (first strings))))
  (loop until (= (length strings) 1) for i below n
        for ch = (most-common-ch-at strings i) do
        (setf strings (remove ch strings :key (partial-1 #'aref _ i) :test-not 'eq)))
  (parse-binary (first strings)))

(defun co2-scrubber-rating (strings &optional (n (length (first strings))))
  (loop until (= (length strings) 1) for i below n
        for ch = (ch-complement (most-common-ch-at strings i)) do
        (setf strings (remove ch strings :key (partial-1 #'aref _ i) :test-not 'eq)))
  (parse-binary (first strings)))

(define-solution (2021 03) (data)
  (values (part1 data) (part2 data)))

(define-test (2021 03) (3985686 2555739))

> (time (test-run))
TEST-2021/03..
Success: 1 test, 2 checks.
Evaluation took:
  0.001 seconds of real time
  0.001470 seconds of total run time (0.000941 user, 0.000529 system)
  100.00% CPU
  3,440,150 processor cycles
  131,024 bytes consed

(defun parse-instructions (data) (mapcar #'parse-instruction data))

(defun parse-instruction (string)
  (cl-ppcre:register-groups-bind ((#'as-keyword dir) (#'parse-integer delta))
      ("(\\w+) (\\d+)" string)
    (cons dir delta)))
(defun dir (i) (car i))
(defun delta (i) (cdr i))

(defun part1 (instructions &aux (horiz 0) (depth 0))
  (dolist (i instructions (* horiz depth))
    (ecase (dir i)
      (:forward (incf horiz (delta i)))
      (:up (decf depth (delta i)))
      (:down (incf depth (delta i))))))

(defun part2 (instructions &aux (horiz 0) (depth 0) (aim 0))
  (dolist (i instructions (* horiz depth))
    (ecase (dir i)
      (:forward (incf horiz (delta i)) (decf depth (* (delta i) aim)))
      (:up (incf aim (delta i)))
      (:down (decf aim (delta i))))))

(define-solution (2021 02) (instructions parse-instructions)
  (values (part1 instructions) (part2 instructions)))

(define-test (2021 02) (1648020 1759818555))

> (time (test-run))
TEST-2021/02..
Success: 1 test, 2 checks.
Evaluation took:
  0.002 seconds of real time
  0.002600 seconds of total run time (0.001565 user, 0.001035 system)
  150.00% CPU
  6,082,778 processor cycles
  327,536 bytes consed

(parse-integers (uiop:read-file-lines "src/2021/day01.txt"))

(defun part1 (numbers)
  (loop for (a b) on numbers
        when b count (< a b)))

(defun part2 (numbers)
  (part1
    (loop for (a b c) on numbers
          when c collect (+ a b c))))

(define-solution (2021 01) (numbers parse-integers)
  (values (part1 numbers) (part2 numbers)))

(define-test (2021 01) (1557 1608))

> (time (test-run))
TEST-2021/01..
Success: 1 test, 2 checks.
Evaluation took:
  0.001 seconds of real time
  0.001252 seconds of total run time (0.000647 user, 0.000605 system)
  100.00% CPU
  2,873,667 processor cycles
  163,808 bytes consed

1: (in-package :cl-user)
2:
5: (in-package :foo)
6:

          1         2
012345678901234567890123
(format t "Hello world")

(defun load-and-build-code (system-name entry-point binary-pathname)
  "Return a list of code strings to eval."
  (list
   "(setf *debugger-hook* #'(lambda (c h) (declare (ignore h)) (uiop:print-condition-backtrace c) (uiop:quit -1)))"
   (format nil "(dolist (entry '~W) (push entry asdf:*central-registry*))" (reverse asdf:*central-registry*))
   (format nil "(asdf:load-system :~A)" system-name)
   (format nil "(setf uiop:*image-entry-point* #'(lambda () ~A))"
           entry-point)
   (format nil "(uiop:dump-image ~S :executable t
  #+sb-core-compression :compression #+sb-core-compression t)"
           binary-pathname)))

position=< 9,  1> velocity=< 0,  2>
position=< 7,  0> velocity=<-1,  0>
position=< 3, -2> velocity=<-1,  1>

(defstruct (star (:conc-name nil)) pos vel)

(defun parse-sky (data)
  (mapcar #'parse-star data))

(defun parse-star (string)
  (destructuring-bind (x y vx vy)
      (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "-?\\d+" string))
    (make-star :pos (list x y) :vel (list vx vy))))

(defun find-message (input)
  (loop :for sky-prev = input :then sky
        :for sky = input :then (sky-next sky)
        :when (> (sky-area sky) (sky-area sky-prev))
        :return (sky-message sky-prev)))

(defun sky-next (sky) (mapcar #'star-move sky))

(defun star-move (star)
  (with-slots (pos vel) star
    (make-star :pos (mapcar #'+ pos vel) :vel vel)))

(defun sky-area (sky)
  (destructuring-bind ((x-min x-max) (y-min y-max)) (sky-box sky)
    (* (- x-max x-min) (- y-max y-min))))

(defun sky-message (sky)
  (destructuring-bind ((x-min x-max) (y-min y-max)) (sky-box sky)
    (let ((output (loop :repeat (1+ (- y-max y-min))
                        :collect (make-string (1+ (- x-max x-min)) :initial-element #\Space))))
      (loop :for star :in sky :for (x y) = (pos star)
            :for row = (nth (- y y-min) output)
            :do (setf (aref row (- x x-min)) #\#))
      (with-output-to-string (s)
        (format s "~%~{~a~^~%~}" output)))))

(defun sky-box (sky)
  (loop :for star :in sky :for (x y) = (pos star)
        :minimize x :into x-min
        :maximize x :into x-max
        :minimize y :into y-min
        :maximize y :into y-max
        :finally (return (list (list x-min x-max) (list y-min y-max)))))

(setq input (parse-sky (uiop:read-file-lines "src/2018/day10.txt")))
> (find-message input)
"
#####   #    #  #####      ###   ####   #       #####   ######
#    #  #    #  #    #      #   #    #  #       #    #  #
#    #  #    #  #    #      #   #       #       #    #  #
#    #  #    #  #    #      #   #       #       #    #  #
#####   ######  #####       #   #       #       #####   #####
#    #  #    #  #           #   #  ###  #       #       #
#    #  #    #  #           #   #    #  #       #       #
#    #  #    #  #       #   #   #    #  #       #       #
#    #  #    #  #       #   #   #   ##  #       #       #
#####   #    #  #        ###     ### #  ######  #       ######"

(defun find-message (input)
  (loop :for time :from 0
        :for sky-prev = input :then sky
        :for sky = input :then (sky-next sky)
        :when (> (sky-area sky) (sky-area sky-prev))
        :return (values (sky-message sky-prev) (1- time))))

(define-solution (2018 10) (sky parse-sky)
  (find-message sky))

(define-test (2018 10) ("
#####   #    #  #####      ###   ####   #       #####   ######
#    #  #    #  #    #      #   #    #  #       #    #  #
#    #  #    #  #    #      #   #       #       #    #  #
#    #  #    #  #    #      #   #       #       #    #  #
#####   ######  #####       #   #       #       #####   #####
#    #  #    #  #           #   #  ###  #       #       #
#    #  #    #  #           #   #    #  #       #       #
#    #  #    #  #       #   #   #    #  #       #       #
#    #  #    #  #       #   #   #   ##  #       #       #
#####   #    #  #        ###     ### #  ######  #       ######" 10831))

> (time (test-run))
TEST-2018/10..
Success: 1 test, 2 checks.
Evaluation took:
  0.440 seconds of real time
  0.416292 seconds of total run time (0.406274 user, 0.010018 system)
  [ Run times consist of 0.029 seconds GC time, and 0.388 seconds non-GC time. ]
  94.55% CPU
  1,012,629,537 processor cycles
  309,925,952 bytes consed

Step C must be finished before step A can begin.
Step C must be finished before step F can begin.
Step A must be finished before step B can begin.
Step A must be finished before step D can begin.
Step B must be finished before step E can begin.
Step D must be finished before step E can begin.
Step F must be finished before step E can begin.

  -->A--->B--
 /    \      \
C      -->D----->E
 \           /
  ---->F-----

(defun parse-instructions (data)
  (let (rez)
    (loop :for string :in data
          :for (step . dep) = (parse-instruction string)
          :for step-entry = (assoc step rez)
          :for dep-entry = (assoc dep rez)
          :if step-entry :do (push dep (cdr step-entry))
          :else :do (push (cons step (list dep)) rez)
          :unless dep-entry :do (push (cons dep nil) rez))
    rez))

(defun parse-instruction (string)
  (cl-ppcre:register-groups-bind ((#'parse-char dep step))
      ("Step (\\w) must be finished before step (\\w) can begin." string)
    (cons step dep)))

((#\E #\F #\D #\B)
 (#\D #\A)
 (#\B #\A)
 (#\F #\C)
 (#\C)
 (#\A #\C))

(defun part1 (instructions &aux completed)
  (loop
    (if (null instructions)
      (return (format nil "~{~C~}" (reverse completed)))
      (destructuring-bind ((step) . rest) (sort-instructions instructions)
        (setf completed (cons step completed)
              instructions (remove-dependency rest step))))))

(defun sort-instructions (instructions)
  (sort (copy-seq instructions) #'instruction<))

(defun instruction< (i1 i2)
  (destructuring-bind (step1 . deps1) i1
    (destructuring-bind (step2 . deps2) i2
      (or (< (length deps1) (length deps2))
          (and (= (length deps1) (length deps2))
               (char< step1 step2))))))

(defun remove-dependency (instructions dependency)
  (loop :for (step . deps) :in instructions
        :collect (cons step (remove dependency deps))))

(defstruct (workers (:conc-name nil)
                    (:constructor make-workers%))
  busy-for
  busy-with)

(defun make-workers (n)
  (make-workers% :busy-for (make-array n :initial-element 0)
                 :busy-with (make-array n :initial-element nil)))

(defparameter *workers-count* 5)

(defun part2 (instructions)
  (let ((workers (make-workers *workers-count*))
        (time 0))
    (loop
      (setf instructions (workers-tick workers instructions))
      (if (every #'null (busy-with workers))
        (return time)
        (incf time)))))

(defun workers-tick (workers instructions)
  (with-slots (busy-for busy-with) workers
    (flet ((try-release-workers ()
             (loop :for i :from 0
                   :for left :across busy-for
                   :for step :across busy-with
                   :if (> left 1) :do (decf (aref busy-for i))
                   :else :collect i :and :do
                   (setf instructions (remove-dependency instructions step)
                         (aref busy-for i) 0
                         (aref busy-with i) nil)))
           (try-assign-work (available)
             (loop :while (and available instructions) :do
                   (let ((i (first available)))
                     (setf instructions (sort-instructions instructions)
                           (aref busy-for i) 0
                           (aref busy-with i) nil)
                     (destructuring-bind ((step . deps) . rest) instructions
                       (if (> (length deps) 0)
                         (return)
                         (setf (aref busy-for i) (step-time step)
                               (aref busy-with i) step
                               available (rest available)
                               instructions rest)))))))
      (let ((available (try-release-workers)))
        (try-assign-work available)
        instructions))))

(defparameter *step-duration* 60)

(defun step-time (step)
  (+ *step-duration* (1+ (- (char-code step) (char-code #\A)))))

(define-solution (2018 7) (instructions parse-instructions)
  (values (part1 instructions) (part2 instructions)))

(define-test (2018 7) ("GRTAHKLQVYWXMUBCZPIJFEDNSO" 1115))

> (time (test-run))
TEST-2018/07..
Success: 1 test, 2 checks.
Evaluation took:
  0.005 seconds of real time
  0.005701 seconds of total run time (0.004362 user, 0.001339 system)
  120.00% CPU
  13,260,235 processor cycles
  2,686,944 bytes consed

initial state: #..#.#..##......###...###

...## => #
..#.. => #
.#... => #
.#.#. => #
.#.## => #
.##.. => #
.#### => #
#.#.# => #
#.### => #
##.#. => #
##.## => #
###.. => #
###.# => #
####. => #

(defun parse-input (data)
  (list (parse-pots (first data)) (parse-notes (cddr data))))

(defun parse-pots (string)
  (let ((pots (make-hset nil)))
    (loop :for i :from 0
          :for ch :across (subseq string 15)
          :when (eq ch #\#) :do (hset-add i pots))
    pots))

(defun parse-notes (data)
  (let ((notes (make-hset nil :test 'equal)))
    (loop :for string :in data
          :for from = (subseq string 0 5) :for to = (char string 9)
          :when (eq to #\#) :do (hset-add from notes))
    notes))

(defun pots (input) (first input))
(defun notes (input) (second input))

(defun part1 (input iterations)
  (destructuring-bind (pots notes) input
    (dotimes (i iterations)
      (setf pots (pots-next pots notes)))
    (sum-plant-positions pots)))

(defun pots-next (pots notes)
  (let ((next (make-hash-table))
        (min (find-min (hset-values pots)))
        (max (find-max (hset-values pots))))
    (loop :for i :from (- min 4) :to (+ max 4)
          :for key = (surrounding-pots pots i)
          :when (hset-contains-p key notes) :do (hset-add i next))
    next))

(defun surrounding-pots (pots i)
  (let ((string (make-string 5 :initial-element #\.)))
    (loop :for j :from (- i 2) :to (+ i 2)
          :for k :from 0
          :when (hset-contains-p j pots)
          :do (setf (char string k) #\#))
    string))

(defun sum-plant-positions (pots)
  (loop :for i :being :the :hash-keys :of pots :sum i))

(let ((input (parse-input (uiop:read-file-lines "src/2018/day12.txt"))))
  (flet ((next (pots)
           (pots-next pots (notes input))))
    (floyd #'next (pots input))
    (error "Never gonna give you up!")))

120: #.##...#.##.##.##.##.##.##...
121: .#.##...#.##.##.##.##.##.##..
122: ..#.##...#.##.##.##.##.##.##.
124: ...#.##...#.##.##.##.##.##.##

(defun sum-plant-positions (pots &optional (center 0))
  (loop :for i :being :the :hash-keys :of pots :sum (- i center)))

> (let ((input (parse-input (uiop:read-file-lines "src/2018/day12.txt"))))
    (flet ((next (pots)
             (pots-next pots (notes input)))
           (key (pots)
             (let ((min (find-min (hset-values pots))))
               (loop :for i :being :the :hash-keys :of pots :sum (- i min)))))
        (floyd #'next (pots input) :key #'key)
        (list 'LOOP 'DETECTED)))
(LOOP DETECTED)

(defun part2 (input iterations)
  (flet ((next (pots)
           (pots-next pots (notes input)))
         (key (pots)
           (let ((min (find-min (hset-values pots))))
             (sum-plant-positions pots min))))
    (destructuring-bind (cycles-at cycle-size pots-new)
        (floyd #'next (pots input) :key #'key)
      (let* ((base (sum-plant-positions pots-new))
             (pots-new-next (pots-next pots-new (notes input)))
             (per-cycle-increment (- (sum-plant-positions pots-new-next) base))
             (cycles (- iterations cycles-at)))
        (assert (= cycle-size 1))
        (+ base (* per-cycle-increment cycles))))))

(define-solution (2018 12) (input parse-input)
  (values (part1 input 20) (part2 input 50000000000)))

> (time (test-run))
TEST-2018/12..
Success: 1 test, 2 checks.
Evaluation took:
  0.060 seconds of real time
  0.108866 seconds of total run time (0.107327 user, 0.001539 system)
  181.67% CPU
  139,759,679 processor cycles
  33,689,536 bytes consed

.#.#...|#.
.....#|##|
.|..|...#.
..|#.....#
#.#|||#|#|
...#.||...
.|....|...
||...#|.#|
|.||||..|.
...#.|..|.

(defun parse-area (data)
  (let ((rows (length data))
        (cols (length (first data))))
    (make-array (list rows cols) :initial-contents data)))

(defun part1 (area iterations)
  (dotimes (i iterations)
    (setf area (area-tick area)))
  (resource-value area))

(defun area-next (area)
  (let* ((rows (array-dimension area 0))
         (cols (array-dimension area 1))
         (next (make-array (list rows cols))))
    (loop :for r :below rows :do
          (loop for c :below cols :do
                (loop :with open = 0 :and trees = 0 :and lumby = 0
                      :for rr :from (max (1- r) 0) :upto (min (1+ r) (1- rows)) :do
                      (loop :for cc :from (max (1- c) 0) :upto (min (1+ c) (1- cols))
                            :unless (and (= rr r) (= cc c)) :do
                            (ecase (aref area rr cc)
                              (#\. (incf open))
                              (#\| (incf trees))
                              (#\# (incf lumby))))
                      :finally (setf (aref next r c)
                                     (ecase (aref area r c)
                                       (#\. (if (>= trees 3) #\| #\.))
                                       (#\| (if (>= lumby 3) #\# #\|))
                                       (#\# (if (and (>= lumby 1) (>= trees 1))
                                              #\# #\.)))))))
    next))

(defun resource-value (area)
  (loop :for i :below (array-total-size area) :for ch = (row-major-aref area i)
        :count (eq ch #\|) :into trees
        :count (eq ch #\#) :into lumby
        :finally (return (* trees lumby))))

(defun part2 (area)
  (destructuring-bind (cycles-at cycle-size area-new)
      (floyd #'area-next area :test 'equalp)
    (let ((remaining (nth-value 1 (floor (- 1000000000 cycles-at) cycle-size))))
      (part1 area-new remaining))))

(define-solution (2018 18) (area parse-area)
  (values (part1 area 10) (part2 area)))

(define-test (2018 18) (549936 206304))

> (time (test-run))
TEST-2018/18..
Success: 1 test, 2 checks.
Evaluation took:
  0.877 seconds of real time
  0.826163 seconds of total run time (0.811340 user, 0.014823 system)
  94.18% CPU
  2,018,921,962 processor cycles
  47,953,424 bytes consed

pos=<0,0,0>, r=4
pos=<1,0,0>, r=1
pos=<4,0,0>, r=3
pos=<0,2,0>, r=1
pos=<0,5,0>, r=3
pos=<0,0,3>, r=1
pos=<1,1,1>, r=1
pos=<1,1,2>, r=1
pos=<1,3,1>, r=1

(defstruct (nanobot (:type list)
                    :conc-name)
  pos r)
(defun x (pos) (first pos))
(defun y (pos) (second pos))
(defun z (pos) (third pos))

(defun parse-nanobots (data)
  (mapcar #'parse-nanobot data))

(defun parse-nanobot (string)
  (cl-ppcre:register-groups-bind ((#'parse-integer x y z r))
      ("pos=<(-?\\d+),(-?\\d+),(-?\\d+)>, r=(\\d+)" string)
    (make-nanobot :pos (list x y z) :r r)))

(defun part1 (bots)
  (let ((strongest (find-max bots :key #'r)))
    (count-if (partial-1 #'nanobot-contains-p strongest (pos _)) bots)))

(defun nanobot-contains-p (nb pos)
  (<= (manhattan-distance (pos nb) pos) (r nb)))

> (let ((bots (parse-nanobots (uiop:read-file-lines "src/2018/day23.txt"))))
    (loop :for bot :in bots :for pos = (pos bot)
          :minimize (x pos) :into x-min
          :maximize (x pos) :into x-max
          :minimize (y pos) :into y-min
          :maximize (y pos) :into y-max
          :minimize (z pos) :into z-min
          :maximize (z pos) :into z-max
          :finally (return (list x-min x-max y-min y-max z-min z-max))))
(-151734092 226831435 -103272011 144820743 -114031252 186064394)

> (let ((bots (parse-nanobots (uiop:read-file-lines "src/2018/day23.txt"))))
    (loop :for bot :in bots
          :minimize (r bot) :into r-min
          :maximize (r bot) :into r-max
          :finally (return (list r-min r-max))))
(49770806 99277279)

(defstruct (box (:type list)
                (:constructor make-box%))
  range-x range-y range-z)

(defun make-box (x-min x-max y-min y-max z-min z-max)
  (let* ((box (make-box% :range-x (list x-min x-max)
                         :range-y (list y-min y-max)
                         :range-z (list z-min z-max)))
         (volume (box-volume box)))
    (assert (or (= volume 0) (= (log volume 2) (floor (log volume 2)))))
    box))

(defun bots-box (bots)
  (loop :for bot :in bots :for pos = (pos bot)
        :minimize (x pos) :into x-min
        :maximize (x pos) :into x-max
        :minimize (y pos) :into y-min
        :maximize (y pos) :into y-max
        :minimize (z pos) :into z-min
        :maximize (z pos) :into z-max
        :finally (return (let* ((largest (max (- x-max x-min)
                                              (- y-max y-min)
                                              (- z-max z-min)))
                                (side (make-pow2 largest)))
                           (make-box x-min (+ x-min side)
                                     y-min (+ y-min side)
                                     z-min (+ z-min side))))))

(defun make-pow2 (number)
  (expt 2 (ceiling (log number 2))))

(defstruct (state (:type list)
                  (:constructor make-state%)
                  :conc-name)
  box num-nanobots volume distance)

(defun make-state (bots box)
  (let ((x (caar box))
        (y (caadr box))
        (z (caaddr box)))
    (make-state% :box box
                 :num-nanobots (count-in-range bots box)
                 :volume (box-volume box)
                 :distance (manhattan-distance (list x y z) (list 0 0 0)))))

(defun count-in-range (nanobots box)
  (count-if (partial-1 #'nanobot-overlaps-p _ box) nanobots))

(defun nanobot-overlaps-p (nb box)
  (loop :with distance = 0
        :for (v-min v-max) :in box
        :for v :in (pos nb)
        :if (< v v-min) :do (incf distance (- v-min v))
        :else if (> v v-max) :do (incf distance (- v v-max))
        :never (> distance (r nb))))

(defun box-volume (box)
  (destructuring-bind ((x-min x-max) (y-min y-max) (z-min z-max)) box
    (* (- x-max x-min) (- y-max y-min) (- z-max z-min))))

(defun part2 (bots)
  (let ((box (bots-box bots))
        (best))
    (loop :with queue = (make-hq :predicate #'state-better-p)
          :initially (hq-insert queue (make-state bots box))
          :until (hq-empty-p queue)
          :for state = (hq-pop queue)
          :do (when (or (not best) (>= (num-nanobots state) (num-nanobots best)))
                (if (box-point-p (box state))
                  (if (or (not best) (state-better-p state best))
                    (setf best state))
                  (dolist (subbox (box-subdivisions (box state)))
                    (hq-insert queue (make-state bots subbox)))))
          :finally (return (distance best)))))

(defun state-better-p (state other)
  (destructuring-bind (num-nanobots volume distance) (rest state)
    (destructuring-bind (o-num-nanobots o-volume o-distance) (rest other)
      (or (> num-nanobots o-num-nanobots)
          (and (= num-nanobots o-num-nanobots)
               (or (< volume o-volume)
                   (and (= volume o-volume)
                        (< distance o-distance))))))))

(defun box-point-p (box)
  (loop :for (min max) :in box
        :always (= min max)))

(defun box-subdivisions (box)
  (unless (box-point-p box)
    (if (= (box-volume box) 1)
      (loop :for (x y z) :in (box-vertices box)
            :collect (make-box x x y y z z))
      (destructuring-bind ((x-min x-max) (y-min y-max) (z-min z-max)) box
        (let ((x-mid (+ x-min (floor (- x-max x-min) 2)))
              (y-mid (+ y-min (floor (- y-max y-min) 2)))
              (z-mid (+ z-min (floor (- z-max z-min) 2))))
          (loop :for (x-min x-max) :on (list x-min x-mid x-max)
                :when x-max :append
                (loop :for (y-min y-max) :on (list y-min y-mid y-max)
                      :when y-max :append
                      (loop :for (z-min z-max) :on (list z-min z-mid z-max)
                            :when z-max :collect (make-box x-min x-max
                                                           y-min y-max
                                                           z-min z-max)))))))))

(defun box-vertices (box)
  (destructuring-bind (x-range y-range z-range) box
    (loop :for x :in x-range :append
          (loop :for y :in y-range :append
                (loop :for z :in z-range :collect (list x y z))))))

(define-solution (2018 23) (bots parse-nanobots)
  (values (part1 bots) (part2 bots)))

(define-test (2018 23) (433 107272899))

> (time (test-run))
TEST-2018/23..
Success: 1 test, 2 checks.
Evaluation took:
  0.132 seconds of real time
  0.115931 seconds of total run time (0.105885 user, 0.010046 system)
  87.88% CPU
  305,851,279 processor cycles
  1,768,384 bytes consed

brew install sdl2
brew install sdl2_image
brew install sdl2_ttf

(ql:quickload :sketch)
(ql:quickload :sketch-examples)
(make-instance 'sketch-examples:brownian)

debugger invoked on a SDL2::SDL-ERROR in thread
#<THREAD "SDL2 Main Thread" RUNNING {10056843D3}>:
  SDL Error: NSWindow drag regions should only be invalidated on the Main Thread!

The current thread is not at the foreground,
SB-THREAD:RELEASE-FOREGROUND has to be called in #<SB-THREAD:THREAD "main thread" waiting on: #<WAITQUEUE Anonymous condition variable {10056847B3}> {1007C501B3}>
for this thread to enter the debugger.

debugger invoked on a SB-SYS:INTERACTIVE-INTERRUPT @7FFF5DB4C58E in thread
#<THREAD "main thread" RUNNING {1007C501B3}>:
  Interactive interrupt at #x7FFF5DB4C58E.
restarts (invokable by number or by possibly-abbreviated name):
  0: [CONTINUE] Return from SB-UNIX:SIGINT.
  1: [ABORT   ] Exit debugger, returning to top level.

#####
#.|.#
#-###
#.|X#
#####

#########
#.|.|.|.#
#-#######
#.|.|.|.#
#-#####-#
#.#.#X|.#
#-#-#####
#.|.|.|.#
#########

(defun parse-doors (data &aux (string (first data)) (doors (make-hset nil)))
  (loop :with pos = 0 :with pos-stack = (list pos)
        :for ch :across string
        :do (ecase ch
              ((#\^) nil)
              ((#\$) (return doors))
              ((#\() (push pos pos-stack))
              ((#\)) (setf pos (pop pos-stack)))
              ((#\|) (setf pos (first pos-stack)))
              ((#\N) (hset-add (+ pos (complex 0 1)) doors) (setf pos (+ pos (complex 0 2))))
              ((#\E) (hset-add (+ pos (complex 1 0)) doors) (setf pos (+ pos (complex 2 0))))
              ((#\S) (hset-add (- pos (complex 0 1)) doors) (setf pos (- pos (complex 0 2))))
              ((#\W) (hset-add (- pos (complex 1 0)) doors) (setf pos (- pos (complex 2 0))))))
  doors)

(defparameter *deltas* '(#C(0 1) #C(1 0) #C(0 -1) #C(-1 0)))

(defun neighbors (doors pos)
  (loop :for d :in *deltas*
        :for door-pos = (+ pos d)
        :when (hset-contains-p door-pos doors)
        :collect (+ pos d d)))

(let ((cost-so-far (nth-value 3 (bfs 0 :neighbors (partial-1 #'neighbors doors)))))
  (reduce #'max (hash-table-values cost-so-far)))

(let ((cost-so-far (nth-value 3 (bfs 0 :neighbors (partial-1 #'neighbors doors)))))
  (count-if (partial-1 #'>= _ 1000) (hash-table-values cost-so-far)))

(define-solution (2018 20) (doors parse-doors)
  (let ((cost-so-far (nth-value 3 (bfs 0 :neighbors (partial-1 #'neighbors doors)))))
    (values
      (reduce #'max (hash-table-values cost-so-far))
      (count-if (partial-1 #'>= _ 1000) (hash-table-values cost-so-far)))))

(define-test (2018 20) (3835 8520))

> (time (test-run))
TEST-2018/20..
Success: 1 test, 2 checks.
Evaluation took:
  0.029 seconds of real time
  0.028120 seconds of total run time (0.018474 user, 0.009646 system)
  96.55% CPU
  67,925,979 processor cycles
  6,870,096 bytes consed

1, 1
1, 6
8, 3
3, 4
5, 5
8, 9

(defvar *tag* 0)

(defun parse-points (data)
  (let ((*tag* 0))
    (mapcar #'parse-point data)))

(defun parse-point (string)
  (cl-ppcre:register-groups-bind ((#'parse-integer col row))
      ("(\\d+), (\\d+)" string)
    (make-point (incf *tag*) row col)))

(defun make-point (tag row col) (cons tag (make-coord row col)))
(defun tag (coord) (car coord))
(defun (setf tag) (value coord) (setf (car coord) value))
(defun coord (point) (cdr point))

(defun make-coord (row col) (complex col (- row)))
(defun row (coord) (- (imagpart coord)))
(defun col (coord) (realpart coord))

(defun part1 (points &aux (bbox (bounding-box points)))
  (destructuring-bind (row-min col-min row-max col-max) bbox
    (let ((sizes (make-hash-table)))
      (loop :for row :from row-min :to row-max :do
            (loop :for col :from col-min :to col-max
                  :for test := (make-coord row col)
                  :for closest := (closest-point test points)
                  :do (if (on-the-border-p test bbox)
                        (setf (gethash (tag closest) sizes) most-negative-fixnum)
                        (incf (gethash (tag closest) sizes 0)))))
      (loop :for size :being :the :hash-values :of sizes :using (hash-key tag)
            :when tag :maximize size))))

(defun bounding-box (points)
  (loop :for p :in points
        :for row := (row (coord p)) :for col := (col (coord p))
        :minimizing row :into row-min
        :maximizing row :into row-max
        :minimizing col :into col-min
        :maximizing col :into col-max
        :finally (return (list row-min col-min row-max col-max))))

(defun closest-point (test points)
  (let (closest closest-distance)
    (dolist (p points)
      (let ((distance (manhattan-distance test (coord p))))
        (when (or (not closest-distance) (<= distance closest-distance))
          (if (or (not closest-distance) (< distance closest-distance))
            (setf closest (list p) closest-distance distance)
            (push p closest)))))
    (when (= (length closest) 1)
      (first closest))))

(defun on-the-border-p (point bbox)
  (destructuring-bind (row-min col-min row-max col-max) bbox
    (or (= (row point) row-min) (= (row point) row-max)
        (= (col point) col-min) (= (col point) col-max))))

(defun part2 (points &aux (bbox (bounding-box points)))
  (destructuring-bind (row-min col-min row-max col-max) bbox
    (loop :for row :from row-min :to row-max :summing
          (loop :for col :from col-min :to col-max
                :for test := (make-coord row col)
                :for total-distance := (total-distance test points)
                :counting (< total-distance 10000)))))

(defun total-distance (test points)
  (loop :for p :in points
        :summing (manhattan-distance test (coord p))))

(define-solution (2018 6) (points parse-points)
  (values (part1 points) (part2 points)))

(define-test (2018 6) (3894 39398))

> (time (test-run))
TEST-2018/06..
Success: 1 test, 2 checks.
Evaluation took:
  0.661 seconds of real time
  0.618545 seconds of total run time (0.585166 user, 0.033379 system)
  93.65% CPU
  1,521,383,260 processor cycles
  14,120,976 bytes consed

[1518-11-01 00:00] Guard #10 begins shift
[1518-11-01 00:05] falls asleep
[1518-11-01 00:25] wakes up
[1518-11-01 00:30] falls asleep
[1518-11-01 00:55] wakes up
[1518-11-01 23:58] Guard #99 begins shift
[1518-11-02 00:40] falls asleep
[1518-11-02 00:50] wakes up
[1518-11-03 00:05] Guard #10 begins shift
[1518-11-03 00:24] falls asleep
[1518-11-03 00:29] wakes up
[1518-11-04 00:02] Guard #99 begins shift
[1518-11-04 00:36] falls asleep
[1518-11-04 00:46] wakes up
[1518-11-05 00:03] Guard #99 begins shift
[1518-11-05 00:45] falls asleep
[1518-11-05 00:55] wakes up

((99 (54 "1518-11-05") (53 "1518-11-05") (52 "1518-11-05") (51 "1518-11-05")
  (50 "1518-11-05") (39 "1518-11-04") (38 "1518-11-04") (37 "1518-11-04")
  (36 "1518-11-04") (49 "1518-11-05" "1518-11-02")
  (48 "1518-11-05" "1518-11-02") (47 "1518-11-05" "1518-11-02")
  (46 "1518-11-05" "1518-11-02") (45 "1518-11-05" "1518-11-04" "1518-11-02")
  (44 "1518-11-04" "1518-11-02") (43 "1518-11-04" "1518-11-02")
  (42 "1518-11-04" "1518-11-02") (41 "1518-11-04" "1518-11-02")
  (40 "1518-11-04" "1518-11-02"))
 (10 (28 "1518-11-03") (27 "1518-11-03") (26 "1518-11-03") (25 "1518-11-03")
  (54 "1518-11-01") (53 "1518-11-01") (52 "1518-11-01") (51 "1518-11-01")
  (50 "1518-11-01") (49 "1518-11-01") (48 "1518-11-01") (47 "1518-11-01")
  (46 "1518-11-01") (45 "1518-11-01") (44 "1518-11-01") (43 "1518-11-01")
  (42 "1518-11-01") (41 "1518-11-01") (40 "1518-11-01") (39 "1518-11-01")
  (38 "1518-11-01") (37 "1518-11-01") (36 "1518-11-01") (35 "1518-11-01")
  (34 "1518-11-01") (33 "1518-11-01") (32 "1518-11-01") (31 "1518-11-01")
  (30 "1518-11-01") (24 "1518-11-03" "1518-11-01") (23 "1518-11-01")
  (22 "1518-11-01") (21 "1518-11-01") (20 "1518-11-01") (19 "1518-11-01")
  (18 "1518-11-01") (17 "1518-11-01") (16 "1518-11-01") (15 "1518-11-01")
  (14 "1518-11-01") (13 "1518-11-01") (12 "1518-11-01") (11 "1518-11-01")
  (10 "1518-11-01") (9 "1518-11-01") (8 "1518-11-01") (7 "1518-11-01")
  (6 "1518-11-01") (5 "1518-11-01")))

(defun parse-schedule (data)
  (let (schedule)
    (labels ((parse (remaining)
               (let ((guard (parse-schedule-guard (pop remaining))))
                 (when guard (fill-in-schedule guard remaining))))
             (fill-in-schedule (guard remaining)
               (if (not (parse-schedule-timeday (first remaining)))
                 (parse remaining)
                 (let ((falls-asleep (parse-schedule-timeday (pop remaining)))
                       (wakes-up (parse-schedule-timeday (pop remaining))))
                   (loop :with day = (cdr falls-asleep)
                         :for time :from (car falls-asleep) :below (car wakes-up)
                         :do (add-asleep-time-day guard time day))
                   (fill-in-schedule guard remaining))))
             (add-asleep-time-day (guard time day)
               (let ((entry (assoc guard schedule)))
                 (unless entry
                   (setf entry (list guard))
                   (push entry schedule))
                 (let ((st-entry (assoc time (sleeptable entry))))
                   (unless st-entry
                     (setf st-entry (list time))
                     (push st-entry (sleeptable entry)))
                   (push day (days st-entry))))))
      (parse (sort (copy-seq data) #'string<)))
    schedule))

(defun parse-schedule-guard (string)
  (cl-ppcre:register-groups-bind ((#'parse-integer guard))
      ("Guard #(\\d+) begins shift" string)
    guard))

(defun parse-schedule-timeday (string)
  (cl-ppcre:register-groups-bind (date (#'parse-integer time))
      ("(\\d{4}-\\d{2}-\\d{2}) 00:(\\d\\d)] (falls asleep|wakes up)" string)
    (cons time date)))

(defun guard (schedule-entry) (car schedule-entry))
(defun sleeptable (schedule-entry) (cdr schedule-entry))
(defun (setf sleeptable) (value schedule-entry) (setf (cdr schedule-entry) value))

(defun minute (sleeptable-entry) (car sleeptable-entry))
(defun days (sleeptable-entry) (cdr sleeptable-entry))
(defun (setf days) (value sleeptable-entry) (setf (cdr sleeptable-entry) value))

(defun part1 (schedule)
  (let ((entry (find-max schedule :key #'minutes-asleep)))
    (* (guard entry) (sleepiest-minute entry))))

(defun minutes-asleep (entry)
  (reduce #'+ (sleeptable entry)
          :key #'(lambda (e) (length (cdr e)))))

(defun sleepiest-minute (entry)
  (multiple-value-bind (st num-days-asleep)
      (find-max (sleeptable entry)
                :key #'(lambda (st)
                        (length (days st))))
    (values (minute st) num-days-asleep)))

(defun part2 (schedule)
  (let ((entry (find-max schedule
                         :key #'(lambda (entry)
                                 (nth-value 1 (sleepiest-minute entry))))))
    (* (guard entry) (sleepiest-minute entry))))

(defun part2 (schedule)
  (let ((entry (find-max schedule
                         :key #'(lambda (entry)
                                 (nth-value 1 (sleepiest-minute entry))))))
    (* (guard entry) (sleepiest-minute entry))))

> (time (test-run))
TEST-2018/04..
Success: 1 test, 2 checks.
Evaluation took:
  0.005 seconds of real time
  0.005837 seconds of total run time (0.004618 user, 0.001219 system)
  120.00% CPU
  13,727,746 processor cycles
  720,224 bytes consed

syntax region lispExcludedFormWithNil
            \ matchgroup=lispExcludedContentStart
            \ start="#+nil ("
            \ skip="|.\{-}|"
            \ matchgroup=lispExcludedContentStop
            \ end=")"
            \ contains=@lispBaseListCluster
highlight link lispExcludedContentStart lispComment
highlight link lispExcludedContentStop lispComment

syntax region lispExcludedList
            \ contained
            \ matchgroup=lispExcludedListOpenParen
            \ start="("
            \ skip="|.\{-}|"
            \ matchgroup=lispExcludedListCloseParen
            \ end=")"
            \ contains=lispExcludedList
highlight link lispExcludedList lispComment
highlight link lispExcludedListOpenParen lispComment
highlight link lispExcludedListCloseParen lispComment

syntax region lispExcludedFormWithNil
            \ matchgroup=lispExcludedContentStart
            \ start="#+nil ("
            \ skip="|.\{-}|"
            \ matchgroup=lispExcludedContentStop
            \ end=")"
            \ contains=lispExcludedList
highlight link lispExcludedFormWithNil lispComment
highlight link lispExcludedContentStart lispComment
highlight link lispExcludedContentStop lispComment

#+nil (list 1 (list 2 3) 4)
                          ^
                          |
                          `- `lispComment` syntax up until this position

#+nil (list 1 (list 2 (list 3 4) 5))
                                   ^
                                   |
                                   `- `lispComment` syntax up until this position

syn cluster lispBaseListCluster add=lispExcludedFormWithNil

(list #+nil (list 1 (list 2 (list 3 4) 5)) 6)
                                         ^ ^
                                         | |
                                         | `- this is highlighed as `lispNumber`
                                         `- `lispComment` syntax up until this position

...

" Excluded forms {{{

syntax region lispExcludedList
            \ contained
            \ matchgroup=lispExcludedListOpenParen
            \ start="("
            \ skip="|.\{-}|"
            \ matchgroup=lispExcludedListCloseParen
            \ end=")"
            \ contains=lispExcludedList

highlight link lispExcludedList lispComment
highlight link lispExcludedListOpenParen lispComment
highlight link lispExcludedListCloseParen lispComment
highlight link lispExcludedContentStart lispComment
highlight link lispExcludedContentStop lispComment

function! s:createLispExcludedSyntaxRegion(regionName, regionPrefix) abort "{{{
    execute 'syntax region' a:regionName
                \ 'matchgroup=lispExcludedContentStart'
                \ 'start="' . a:regionPrefix . '("'
                \ 'skip="|.\{-}|"'
                \ 'matchgroup=lispExcludedContentStop'
                \ 'end=")"'
                \ 'contains=lispExcludedList'
    execute 'highlight link' a:regionName 'lispComment'
    execute 'syntax cluster lispBaseListCluster add=' . a:regionName
endfunction " }}}


" ... with NIL {{{

syntax match lispExcludedElementWithNil /\v\#\+nil [^(`][^ ]+/
highlight link lispExcludedElementWithNil lispComment
syn cluster lispBaseListCluster add=lispExcludedElementWithNil

call s:createLispExcludedSyntaxRegion("lispExcludedFormWithNil", "#+nil ")
call s:createLispExcludedSyntaxRegion("lispExcludedQuotedFormWithNil", "#+nil '")
call s:createLispExcludedSyntaxRegion("lispExcludedQuasiQuotedFormWithNil", "#+nil `")
call s:createLispExcludedSyntaxRegion("lispExcludedSharpsignedDotFormWithNil", "#+nil #\.")

" }}}
" ... with #:_description_ {{{

syntax match lispExcludedElementWithDescription /\v\#\+\#:[^ ]+ [^(`][^ ]+/
highlight link lispExcludedElementWithDescription lispComment
syn cluster lispBaseListCluster add=lispExcludedElementWithDescription

call s:createLispExcludedSyntaxRegion("lispExcludedFormWithDescription", "#+#:[^ ]\\+ ")
call s:createLispExcludedSyntaxRegion("lispExcludedQuotedFormWithDescription", "#+#:[^ ]\\+ '")
call s:createLispExcludedSyntaxRegion("lispExcludedQuasiQuotedFormWithDescription", "#+#:[^ ]\\+ `")
call s:createLispExcludedSyntaxRegion("lispExcludedSharpsignedDotFormWithDescription", "#+#:[^ ]\\+ #\.")

" }}}

" }}}

#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
                                       (user-homedir-pathname))))
  (if (probe-file quicklisp-init)
      (load quicklisp-init)
      (progn
        (load (merge-pathnames "quicklisp.lisp" *load-truename*))
        (funcall (find-symbol "INSTALL" (find-package "QUICKLISP-QUICKSTART"))))))

(ql:quickload '("face-mask-ce-verifier-web" "swank-tunnel"))
(fmcv-web:start :web-interface "0.0.0.0")

;;; Quicklisp (installed in the current directory)
#-quicklisp
(let ((quicklisp-init (merge-pathnames ".quicklisp/setup.lisp" *default-pathname-defaults*)))
  (if (probe-file quicklisp-init)
      (load quicklisp-init)
      (progn
        (load (merge-pathnames "quicklisp.lisp" *load-truename*))
        (funcall (find-symbol "INSTALL" (find-package "QUICKLISP-QUICKSTART"))
                 :path (merge-pathnames ".quicklisp/" *default-pathname-defaults*)))))

;;; Locally cached FASLs
(let ((cache-dir (merge-pathnames ".common-lisp/" *default-pathname-defaults*)))
  (asdf:initialize-output-translations
    `(:output-translations (t (,cache-dir :implementation))
      :disable-cache
      :ignore-inherited-configuration)))

~/Face-mask-CE-marking-verifier$ ls .quicklisp/
asdf.lisp     dists       quicklisp   tmp
client-info.sexp  local-projects  setup.lisp

~/Face-mask-CE-marking-verifier$ ls .common-lisp/
sbcl-2.1.2.nixos-linux-x64

task path: /Users/matteolandi/Workspace/matteolandi.net/system/ansible/roles/matteolandi-index/tasks/main.yml:4
fatal: [matteolandi.net]: FAILED! => {"changed": false, "msg": "Error pulling matteolandi.net:5000/matteolandi-index - code: None message: unable to ping re
gistry endpoint https://matteolandi.net:5000/v0/\nv2 ping attempt failed with error: Get https://matteolandi.net:5000/v2/: x509: certificate has expired or
is not yet valid\n v1 ping attempt failed with error: Get https://matteolandi.net:5000/v1/_ping: x509: certificate has expired or is not yet valid"}
 ____________
< PLAY RECAP >
 ------------
        \   ^__^
         \  (oo)\_______
            (__)\       )\/\
                ||----w |
                ||     ||

matteolandi.net            : ok=2    changed=0    unreachable=0    failed=1    skipped=0    rescued=0    ignored=0

yum update -y

task path: /Users/matteolandi/Workspace/matteolandi.net/system/ansible/roles/docker-login/tasks/main.yml:1
fatal: [matteolandi.net]: FAILED! => {"changed": false, "msg": "Failed to import the required Python library (Docker SDK for Python: docker (Python >= 2.7)
or docker-py (Python 2.6)) on centos-512mb-fra1-01.localdomain's Python /usr/bin/python. Please read module documentation and install in the appropriate loc
ation. If the required library is installed, but Ansible is using the wrong Python interpreter, please consult the documentation on ansible_python_interpret
er, for example via `pip install docker` or `pip install docker-py` (Python 2.6). The error was: cannot import name certs"}
 ____________
< PLAY RECAP >
 ------------
        \   ^__^
         \  (oo)\_______
            (__)\       )\/\
                ||----w |
                ||     ||

matteolandi.net            : ok=33   changed=1    unreachable=0    failed=1    skipped=0    rescued=0    ignored=0

pip install --upgrade pip

pip uninstall docker requests urllib3

pip install --upgrade urllib3 requests docker

> (or #+nil "WTF?!" "Hello, world!")
"Hello, world!"

> (pushnew :nil *features*)
(:NIL :QUICKLISP :ASDF3.3 :ASDF3.2 :ASDF3.1 :ASDF3 :ASDF2 :ASDF :OS-MACOSX
 :OS-UNIX :NON-BASE-CHARS-EXIST-P :ASDF-UNICODE :X86-64 :GENCGC :64-BIT
 :ANSI-CL :BSD :COMMON-LISP :DARWIN :IEEE-FLOATING-POINT :LITTLE-ENDIAN :MACH-O
 :PACKAGE-LOCAL-NICKNAMES :SB-CORE-COMPRESSION :SB-LDB :SB-PACKAGE-LOCKS
 :SB-THREAD :SB-UNICODE :SBCL :UNIX)

> (or #+nil "WTF?!" "Hello, world!")
"WTF?!"

> (setf *features* (delete :nil *features*))
(:QUICKLISP :ASDF3.3 :ASDF3.2 :ASDF3.1 :ASDF3 :ASDF2 :ASDF :OS-MACOSX :OS-UNIX
 :NON-BASE-CHARS-EXIST-P :ASDF-UNICODE :X86-64 :GENCGC :64-BIT :ANSI-CL :BSD
 :COMMON-LISP :DARWIN :IEEE-FLOATING-POINT :LITTLE-ENDIAN :MACH-O
 :PACKAGE-LOCAL-NICKNAMES :SB-CORE-COMPRESSION :SB-LDB :SB-PACKAGE-LOCKS
 :SB-THREAD :SB-UNICODE :SBCL :UNIX)

> (or #+#:excluded "WTF?!" "Hello, world!")
"Hello, world!"

> (pushnew #:excluded *features*)
; in: PUSHNEW #:EXCLUDED
;     (LET* ((#:ITEM #:EXCLUDED))
;       (SETQ *FEATURES* (ADJOIN #:ITEM *FEATURES*)))
;
; caught WARNING:
;   undefined variable: #:EXCLUDED
;
; compilation unit finished
;   Undefined variable:
;     #:EXCLUDED
;   caught 1 WARNING condition

debugger invoked on a UNBOUND-VARIABLE @5351833B in thread
#<THREAD "main thread" RUNNING {1001548143}>:
  The variable #:EXCLUDED is unbound.
restarts (invokable by number or by possibly-abbreviated name):
  0: [CONTINUE   ] Retry using #:EXCLUDED.
  1: [USE-VALUE  ] Use specified value.
  2: [STORE-VALUE] Set specified value and use it.
  3: [ABORT      ] Exit debugger, returning to top level.

((LAMBDA ()))
   source: (LET* ((#:ITEM #:EXCLUDED))
             (SETQ *FEATURES* (ADJOIN #:ITEM *FEATURES*)))
0] 3

> (pushnew :excluded *features*)
(:EXCLUDED :QUICKLISP :ASDF3.3 :ASDF3.2 :ASDF3.1 :ASDF3 :ASDF2 :ASDF :OS-MACOSX
 :OS-UNIX :NON-BASE-CHARS-EXIST-P :ASDF-UNICODE :X86-64 :GENCGC :64-BIT
 :ANSI-CL :BSD :COMMON-LISP :DARWIN :IEEE-FLOATING-POINT :LITTLE-ENDIAN :MACH-O
 :PACKAGE-LOCAL-NICKNAMES :SB-CORE-COMPRESSION :SB-LDB :SB-PACKAGE-LOCKS
 :SB-THREAD :SB-UNICODE :SBCL :UNIX)

> (or #+#:excluded "WTF?!" "Hello, world!")
"Hello, world!"

> (setf *features* (delete :excluded *features*))
(:QUICKLISP :ASDF3.3 :ASDF3.2 :ASDF3.1 :ASDF3 :ASDF2 :ASDF :OS-MACOSX :OS-UNIX
 :NON-BASE-CHARS-EXIST-P :ASDF-UNICODE :X86-64 :GENCGC :64-BIT :ANSI-CL :BSD
 :COMMON-LISP :DARWIN :IEEE-FLOATING-POINT :LITTLE-ENDIAN :MACH-O
 :PACKAGE-LOCAL-NICKNAMES :SB-CORE-COMPRESSION :SB-LDB :SB-PACKAGE-LOCKS
 :SB-THREAD :SB-UNICODE :SBCL :UNIX)

diff --git a/.vim/vimrc b/.vim/vimrc
index 69c5db4..6ca6151 100644
--- a/.vim/vimrc
+++ b/.vim/vimrc
diff --git a/.vim/after/syntax/lisp.vim b/.vim/after/syntax/lisp.vim
index 5a2859c..cdf3c03 100644
--- a/.vim/after/syntax/lisp.vim
+++ b/.vim/after/syntax/lisp.vim
@@ -855,7 +921,7 @@ function! s:vim_sexp_mappings() " {{{
         " Check if it's a #+nil marker
         execute "normal \<Plug>(sexp_move_to_prev_element_head)"
         normal yW
-        if @@ =~? "#+nil"
+        if @@ =~? "#+#:"
             let should_add_comment = 0
         endif
         let @@ = reg_save
@@ -864,7 +930,7 @@ function! s:vim_sexp_mappings() " {{{
         " Do the needed
         if should_add_comment
             " Insert the comment marker, and move back to the element / form
-            execute "normal! i#+nil "
+            execute "normal! i#+#:excluded "
             execute "normal \<Plug>(sexp_move_to_next_element_head)"
         else
             " Move back, and the delete forward
diff --git a/.vim/after/syntax/lisp.vim b/.vim/after/syntax/lisp.vim
index 5a2859c..cdf3c03 100644
--- a/.vim/after/syntax/lisp.vim
+++ b/.vim/after/syntax/lisp.vim
@@ -11,3 +11,11 @@ syn cluster lispBaseListCluster add=lispExcludedForm
 syntax match lispExcludedElement /\v\#\+nil [^(][^ ]+/
 highlight link lispExcludedElement lispComment
 syn cluster lispBaseListCluster add=lispExcludedElement
+
+syntax match lispExcludedFormWithDescription /\v\#\+\#:[^ ]+ \([^)]+\)/
+highlight link lispExcludedFormWithDescription lispComment
+syn cluster lispBaseListCluster add=lispExcludedFormWithDescription
+
+syntax match lispExcludedElementWithDescription /\v\#\+\#:[^ ]+ [^(][^ ]+/
+highlight link lispExcludedElementWithDescription lispComment
+syn cluster lispBaseListCluster add=lispExcludedElementWithDescription

(hunchentoot:define-easy-handler (index :uri "/") (q)
  (let ((bodies (and q (fmcv:nb-search q))))
    (with-page (:title "Face Mask CE Verifier")
      ...

(defvar *cached-bodies* (fmcv:nb-search "00"))

(hunchentoot:define-easy-handler (index :uri "/") (q)
  (let ((bodies (and q *cached-bodies*)))
    (with-page (:title "Face Mask CE Verifier")

(hunchentoot:define-easy-handler (index :uri "/") (q)
  (let ((bodies (and q *cached-bodies* #+nil (fmcv:nb-search q))))
    (with-page (:title "Face Mask CE Verifier")

(hunchentoot:define-easy-handler (index :uri "/") (q)
  (let ((bodies (and q #+nil *cached-bodies* (fmcv:nb-search q))))
    (with-page (:title "Face Mask CE Verifier")

" Comment out the current form / element
function! ToggleCommonLispComment(toggle_form) abort "{{{
    " Move at the start of the current element / form; if on an open paren
    " already, do nothing
    if getline('.')[col('.') - 1] != "("
        let motion = ""
        if a:toggle_form
            let motion = "\<Plug>(sexp_move_to_prev_bracket)"
        else
            let motion = "\<Plug>(sexp_move_to_prev_element_head)"
        endif
        execute "normal " . motion
    endif

    " Figure out if we need to add a comment, or remove the existing one
    let should_add_comment = 1
    let save_cursor = getcurpos()
    let reg_save = @@
    " Move back to the previous element
    " Yank it
    " Check if it's a #+nil marker
    execute "normal \<Plug>(sexp_move_to_prev_element_head)"
    normal yW
    if @@ =~? "#+nil"
        let should_add_comment = 0
    endif
    let @@ = reg_save
    call setpos('.', save_cursor)

    " Do the needed
    if should_add_comment
        " Insert the comment marker, and move back to the element / form
        execute "normal! i#+nil "
        execute "normal \<Plug>(sexp_move_to_next_element_head)"
    else
        " Move back, and the delete forward
        execute "normal \<Plug>(sexp_move_to_prev_element_head)"
        normal dW
    endif
endfunction
" }}}
nmap <silent><buffer>   gce  :call ToggleCommonLispComment(0)<CR>
nmap <silent><buffer>   gcf  :call ToggleCommonLispComment(1)<CR>

syntax match lispExcludedForm /\v\#\+nil \([^)]+\)/
highlight link lispExcludedForm lispComment
syn cluster lispBaseListCluster add=lispExcludedForm

syntax match lispExcludedElement /\v\#\+nil [^(][^ ]+/
highlight link lispExcludedElement lispComment
syn cluster lispBaseListCluster add=lispExcludedElement

" Star search plugin {{{
"
" Few things that this plugin does, and that others might not:
"
" 1. Works in both normal, and visual mode
" 2. Plays nice with smartcase search -- vim's builtin * / # mappings do not
"    support that
" 3. Does not automatically jump to the _first_ next occurrence; instead, moves
"    the cursor to the beginning of the current occurrence so that if for
"    whatever reason you decided to swap search direction with `N`, you would
"    be taken to the first previous occurrence (and not to the beginning of the
"    current word
"
" Normal mode:
"
" - Save the word under the cursor -- running `expand('<cword>')` while
"   searching actually cuases the cursor to move around one char forward, and
"   if you happened to start from the end of the word, that
"   'move-one-char-ahead' behavior would actually move the cursor over to the
"   next word, causing `expand('<cword>')` to return something unexpected
"   instead
" - Saves the current view (so we can restore it later)
" - Triggers the word-boundary-d search
" - Restores to the previous view -- effectively undoing the first jump
" - Checks if the cursor wasn't already at the beginning of a match, and if
"   not, runs `b` to move at the beginning of the current word
nnoremap <Plug>NormalStarSearchForward
            \ :let star_search_cword = expand('<cword>')<CR>
            \ :let star_search_view = winsaveview()<CR>
            \ /\<<C-R>=escape(star_search_cword, '*\')<CR>\><CR>
            \ :call winrestview(star_search_view)<CR>
            \ :execute "normal! " . (getline('.')[col('.') - 1:] !~# '^' . star_search_cword ? "b" : "")<CR>
nnoremap <Plug>NormalStarSearchBackward
            \ :let star_search_cword = expand('<cword>')<CR>
            \ :let star_search_view = winsaveview()<CR>
            \ ?\<<C-R>=escape(star_search_cword, '*\')<CR>\><CR>
            \ :call winrestview(star_search_view)<CR>
            \ :execute "normal! " . (getline('.')[col('.') - 1:] !~# '^' . star_search_cword ? "b" : "")<CR>
nmap * <Plug>NormalStarSearchForward
nmap # <Plug>NormalStarSearchBackward

" Visual mode:
"
" - Saves the current view (so we can restore it later)
" - Triggers the search -- without word-boundaries...you can use normal the
"   normal mode alternative for that
" - Restores to the previous view -- effectively undoing the first jump
xnoremap <Plug>VisualStarSearchForward
            \ :<C-U>let star_search_view = winsaveview()<CR>
            \ /<C-R>=escape(GetCurrentSelection(visualmode()), '*\')<CR><CR>
            \ :call winrestview(star_search_view)<CR>
xnoremap <Plug>VisualStarSearchBackward
            \ :<C-U>let star_search_view = winsaveview()<CR>
            \ ?<C-R>=escape(GetCurrentSelection(visualmode()), '*\')<CR><CR>
            \ :call winrestview(star_search_view)<CR>
xmap * <Plug>VisualStarSearchForward
xmap # <Plug>VisualStarSearchBackward

" }}}

function! s:ScratchThis() abort
    setlocal buftype=nowrite bufhidden=delete noswapfile
endfunction

command! ScratchThis call s:ScratchThis()

nnoremap ! :! <C-R><C-F><Home><Right>

class Bucket < ActiveRecord::Base
  ...
  belongs_to :account
  delegated_type :bucketable, types: %w[ Project ] # this adds bucketable_id, bucketable_type to the schema ... or `belongs_to :bucketable`
  has_many :recordings, dependent: :destroy
  ...
end

class Recording < ActiveRecord::Base
  ...
  belongs_to :bucket, touch: true
  belongs_to: :creator, class_name: 'Person', default: -> { Current.person }
  ...
  delegated_type :recordable, types: %w[ Todo Todolist Todoset Dock ] # this adds recordable_id and recordable_type to the schema

  delegate :account, to: :bucket
end

module Recordable extend ActiveSupport::Concern
  included do
    has_many :recordings, as: :recordable # same as specified inside `Recording` as `delegated_type`
  end
end

module Recording::Tree
  extend ActiveSupport::Concern

  included do
    belongs_to :parent, class_name: 'Recording', optional: true
    has_many :children, class_name: 'Recording', foreign_key: :parent_id
  end
end

class TodosController < ApplicationController
  def create
    @recording = @bucket.record new_todo
  end

  def update
    @recording.update! recordable: new_todo
  end

  private
    def new_todo
      Todo.new params.require(:todo).permit(:content, :description, :starts_on, :due_on)
    end
end

class Bucket < ActriveRecord::Base
  ...
  def record(recordable, children: nil, parent: nil, status: :active, creator: Current.person, **options)
    transaction do
      recordable.save!
      options.merge!(recordable: recordable, parent: parent, status: status, creator: creator)

      recordings.create!(options).tap do | recording |
        Array(children).each do | child |
          record child, parent: recording, status: status, creator: creator
        end
      end
    end
  end
end

>> Recording.find(111111111).recordable.id
=> 33333333333333

>> Recording.find(222222222).recordable.id
=> 33333333333333

class Event < ActiveRecord::Base
  belongs_to: :recording, required: false
  belongs_to: :bucket
  belongs_to: :creator, class_name: 'Person'

  has_one :detail, dependent: :delete, required: true

  include Notifiable...Requested
  ...

end

module Recording::Eventable
  extends ActiveSupport::Concern
  ...
  included do
    has_many :events, dependent: :destroy

    after_create :track_created
    after_update :track_updated
    after_update_commit :forget_adoption_tracking, :forget_events
  end

  def track_event(action, recordable_previous: nil, **particulars)
    Event.create! \
      recording: self, recordable: recordable, recordable_previous: recordable_previous,
      bucket: bucket, creator: Current.person, action: action,
      detail: Event::Detail.new(particulars)
  end
  ...
end

    after_create: :track_created
    after_update :track_updated

  private
    def track_created
      track_event :created, status_was: status
    end

function Queue(worker) {
  var queue_items = [];
  var working = false;

  function runNext() {
    if(working)
      return;
    if(queue_items.length === 0)
      return;
    working = true;
    var item = queue_items.shift();
    worker(item.data, function(val) {
      working = false;
      setTimeout(item.callback, 0, val);
      runNext();
    });
  }

  return function(data, callback) {
    queue_items.push({
      data: data,
      callback: callback || function(){}
    });
    setTimeout(runNext, 0);
  };
}

function calc_cart_worker(cart, done) {
  calc_cart_total(cart, function(total) {
    update_total_dom(total);
    done(total);
  });
}

var update_total_queue = Queue(calc_cart_worker);

function DroppingQueue(max, worker) {
  var queue_items = [];
  var working = false;

  function runNext() {
    if(working)
      return;
    if(queue_items.length === 0)
      return;
    working = true;
    var item = queue_items.shift();
    worker(item.data, function(val) {
      working = false;
      setTimeout(item.callback, 0, val);
      runNext();
    });
  }

  return function(data, callback) {
    queue_items.push({
      data: data,
      callback: callback || function(){}
    });
    while(queue_items.length > max)
      queue_items.shift();
    setTimeout(runNext, 0);
  };
}

function calc_cart_worker(cart, done) {
  calc_cart_total(cart, function(total) {
    update_total_dom(total);
    done(total);
  });
}

var update_total_queue = DroppingQueue(1, calc_cart_worker);

function Cut(num, callback) {
  var num_finished = 0;
  return function() {
    num_finished += 1;
    if(num_finished === num)
      callback();
  };
}

var done = Cut(3, function() {
  console.log("3 timelines are finished");
});

done();
done();
done(); // only this one logs

function JustOnce(action) {
  var alreadyCalled = false;
  return function(a, b, c) {
    if(alreadyCalled) return;
    alreadyCalled = true;
    return action(a, b, c);
  };
}

function sendAddToCartText(number) {
  sendTextAjax(number, "Thanks for adding something to your cart. Reply if you have any questions!");
}

var sendAddToCartTextOnce = JustOnce(sendAddToCartText);

sendAddToCartTextOnce("555-555-5555-55"); // only this one logs
sendAddToCartTextOnce("555-555-5555-55");
sendAddToCartTextOnce("555-555-5555-55");
sendAddToCartTextOnce("555-555-5555-55");

function ValueCell(initialValue) {
  var currentValue = initialValue;
  var watchers = [];
  return {
    val: function() {
      return currentValue;
    },
    update: function(f) {
      var oldValue = currentValue;
      var newValue = f(oldValue);
      if(oldValue !== newValue) {
        currentValue = newValue;
        forEach(watchers, function(watcher) {
          watcher(newValue);
        });
      }
    },
    addWatcher: function(f) {
      watchers.push(f);
    }
  };
}

var shopping_cart = ValueCell({});

function add_item_to_cart(name, price) {
  var item = make_cart_item(name, price);
  shopping_cart.update(function(cart) {
    return add_item(cart, item);
  });
  var total = calc_total(shopping_cart.val());
  set_cart_total_dom(total);
  update_tax_dom(total);
}

shopping_cart.addWatcher(update_shipping_icons);

function FormulaCell(upstreamCell, f) {
  var myCell = ValueCell(f(upstreamCell.val()));
  upstreamCell.addWatcher(function(newUpstreamValue) {
    myCell.update(function(currentValue) {
      return f(newUpstreamValue);
    });
  });
  return {
    val: myCell.val,
    addWatcher: myCell.addWatcher
  };
}

var shopping_cart = ValueCell({});

var cart_total = FormulaCell(shopping_cart, calc_total);

function add_item_to_cart(name, price) {
  var item = make_cart_item(name, price);
  shopping_cart.update(function(cart) {
    return add_item(cart, item);
  });
}

shopping_cart.addWatcher(update_shipping_icons);
cart_total.addWatcher(set_cart_total_dom);
cart_total.addWatcher(update_tax_dom);

$ git clone https://github.com/40ants/ngrok.git
$ sbcl --noinform
> ...

(pushnew '(merge-pathnames (parse-namestring "ngrok/")
             *default-pathname-defaults*)
           asdf:*central-registry*)

(ql:quickload '("clack" "ngrok" "swank" "uiop"))

(defun main ()
  (clack)
  (swank)
  (ngrok))

(defvar *handler* nil)

(defun clack () (setf *handler* (clack:clackup #'srv :address "localhost" :port 5000)))

(defun srv (env) (app env))

(defun app (env)
  (declare (ignore env))
  '(200 (:content-type "text/plain") ("Hello, Clack!")))

(defun getenv-or-readline (name)
  "Gets the value of the environment variable, or asks the user to provide
   a value for it."
  (or (uiop:getenv name)
      (progn
        (format *query-io* "~a=" name)
        (force-output *query-io*)
        (read-line *query-io*))))

(defvar *slime-secret* (getenv-or-readline "SLIME_SECRET"))
(defparameter *swank-port* 4006)

(defun swank ()
  (write-slime-secret)
  (swank:create-server :port *swank-port* :dont-close t))

(defun write-slime-secret ()
  (with-open-file (stream "~/.slime-secret" :direction :output :if-exists :supersede)
    (write-string *slime-secret* stream)))

(defvar *ngrok-auth-token* (getenv-or-readline "NGROK_AUTH_TOKEN"))

(defun ngrok () (ngrok:start *swank-port* :auth-token *ngrok-auth-token*))

> (main)
Hunchentoot server is started.
Listening on localhost:5000.
;; Swank started at port: 4006.
 <INFO> [10:13:43] ngrok setup.lisp (install-ngrok) -
  Ngrok already installed, changing authtoken
 <INFO> [10:13:44] ngrok setup.lisp (start) - Starting Ngrok on TCP port 4006
 <INFO> [10:13:44] ngrok setup.lisp (start) -
  Tunnnel established! Connect to the tcp://6.tcp.eu.ngrok.io:12321
"tcp://6.tcp.eu.ngrok.io:12321"

$ curl https://localhost:5000
Hello, Clack!

(defun app (env)
  (declare (ignore env))
  '(200 (:content-type "text/plain") ("Hello, Matteo!")))

$ curl https://localhost:5000
Hello, Matteo!

(ql:quickload "drakma")     ; to fire HTTP requests
(ql:quickload "local-time") ; to track of when the scraping last happened
(ql:quickload "st-json")    ; well...you guessed it
(ql:quickload "uiop")       ; read env variables

(defun main ()
  (loop
    (with-simple-restart (continue "Ignore the error")
      (wait-for-active-categories)
      (send-sms))))

(defvar *last-run-at* nil "When the categories scraper last run")

(defun wait-for-active-categories ()
  (loop :when (categories-activated-p) :return it
        :do (progn
              (setf *last-run-at* (local-time:now))
              (random-sleep))))

(defvar *categories-snapshots* nil
  "List of categories snapshots -- handy to see what changed over time.")

(defun categories-activated-p ()
  (let ((categories (fetch-categories)))
    (unless *categories-snapshots*
      (push categories *categories-snapshots*))
    (prog1 (find-recently-activated categories)
      (push categories *categories-snapshots*)
      (harvest-categories-snapshots))))

(define-condition html-not-json-content-type () ())

(defparameter *prenotavaccino-home-url* "https://prenotavaccino.sanita.toscana.it")
(defparameter *prenotavaccino-categories-url* "https://prenotavaccino.sanita.toscana.it/api/index")

(defvar *cookie-jar* (make-instance 'drakma:cookie-jar)
  "Cookie jar to hold session cookies when interacting with Prenotavaccino")

(defun parse-json (response)
  (let* ((string (flexi-streams:octets-to-string response)))
    (st-json:read-json string)))

(defun fetch-categories ()
  (flet ((fetch-it ()
           (multiple-value-bind (response status headers)
               (drakma:http-request *prenotavaccino-categories-url* :cookie-jar *cookie-jar*)
             (declare (ignore status))
             (let ((content-type (cdr (assoc :content-type headers))))
               (if (equal content-type "text/html")
                   (error 'html-not-json-content-type)
                 response))))
         (parse-it (response)
           (st-json:getjso "categories" (parse-json response))))
    (parse-it
      (handler-case (fetch-it)
        (html-not-json-content-type (c)
          (declare (ignore c))
          (format t "~&Received HTML instead of JSON. Retrying assuming the previous session expired...")
          (fetch-it))))))

(defun category-name (cat) (st-json:getjso "idCategory" cat))
(defun category-title (cat) (st-json:getjso "title" cat))
(defun category-active-p (cat)
  (and (eql (st-json:getjso "active" cat) :true)
       (eql (st-json:getjso "forceDisabled" cat) :false)))

(defun find-recently-activated (categories)
  (flet ((category-by-name (name categories)
           (find name categories :key #'category-name :test #'equal)))
    (let ((prev-categories (first *categories-snapshots*)))
      (loop :for cat :in categories
            :for cat-prev = (category-by-name (category-name cat) prev-categories)
            :when (and (category-active-p cat)
                       (or (not cat-prev)
                           (not (category-active-p cat-prev))
                           (not (equal (category-title cat-prev) (category-title cat)))))
            :collect cat))))

(defparameter *categories-snapshots-max-length* 50
  "Maximum numbers of categories snapshots to keep around")

(defun harvest-categories-snapshots ()
  (when (> (length *categories-snapshots*) *categories-snapshots-max-length*)
    (setf *categories-snapshots*
          (subseq *categories-snapshots* 0 (1+ *categories-snapshots-max-length*)))))

(defparameter *sleep-seconds-min* 60
  "Minimum number of seconds the scraper will sleep for")
(defparameter *sleep-seconds-jitter* 5
  "Adds a pinch of randomicity -- see RANDOM-SLEEP")

(defun random-sleep ()
  (sleep (+ *sleep-seconds-min* (random *sleep-seconds-jitter*))))

(defun getenv-or-readline (name)
  "Gets the value of the environment variable, or asks the user to provide
  a value for it."
  (or (uiop:getenv name)
      (progn
        (format *query-io* "~a=" name)
        (force-output *query-io*)
        (read-line *query-io*))))

(defvar *twilio-account-sid* (getenv-or-readline "TWILIO_ACCOUNT_SID"))
(defvar *twilio-auth-token* (getenv-or-readline "TWILIO_AUTH_TOKEN"))
(defvar *twilio-messages-api-url*
  (format nil "https://api.twilio.com/2010-04-01/Accounts/~a/Messages.json" *twilio-account-sid*))
(defvar *twilio-from* (getenv-or-readline "TWILIO_FROM_NUMBER"))
(defvar *twilio-to-list*
  (split-sequence:split-sequence #\Space (getenv-or-readline "TWILIO_TO_NUMBERS")))

(defun send-sms (&optional (body (sms-body)))
  (flet ((send-it (to)
           (drakma:http-request *twilio-messages-api-url*
                                :method :post
                                :basic-authorization `(,*twilio-account-sid* ,*twilio-auth-token*)
                                :parameters `(("Body" . ,body)
                                              ("From" . ,*twilio-from*)
                                              ("To" . ,to)))))
    (let (failed)
      (dolist (to *twilio-to-list*)
        (let* ((jso (parse-json (send-it to)))
               (error-code (st-json:getjso "error_code" jso)))
          (unless (eql error-code :null)
            (push jso failed))))
      (if failed
          (error "Failed to deliver **all** SMSs: ~a" failed)
          t))))

(defun sms-body ()
  (let* ((categories (first *categories-snapshots*))
         (*categories-snapshots* (cdr *categories-snapshots*)))
    (format nil "Ora attivi: ~{~A~^, ~} -- ~a"
            (mapcar #'category-title
                    (find-recently-activated categories))
            *prenotavaccino-home-url*)))

> (find "LastMinute" (first *categories-snapshots*)
        :key #'category-name
        :test #'string=)
#S(ST-JSON:JSO
   :ALIST (("idCategory" . "LastMinute") ("active" . :TRUE)
           ("forceDisabled" . :FALSE) ("start" . "2021-06-02")
           ("end" . "2021-07-31") ("title" . "Last<br/>Minute")
           ("subtitle"
            . "<b>ATTENZIONE.</b> Prenotazione degli slot rimasti disponibili nelle prossime 24H.")
           ("message" . "Il servizio aprirà alle ore 19:00 di ogni giorno")
           ("updateMaxMinYear" . :TRUE)))

> (sms-body)
"Ora attivi: Last<br/>Minute -- https://prenotavaccino.sanita.toscana.it"

10 PRINT CHR$(205.5+RND(1)); : GOTO 10

(loop (princ (aref "/\\" (random 2))))

(loop
  (finish-output)
  (princ (aref "/\\" (random 2)))
  (sleep (/ 1 30)))

let currentJob = Promise.resolve();
let currentController;

function showSearchResults(input) {
  if (currentController) currentController.abort();
  currentController = new AbortController();
  const { signal } = currentController;

  currentJob = currentJob
    .finally(async () => {
      try {
        startSpinner();
        const response = await fetch(getSearchUrl(input), { signal });
        await displayResults(response, { signal });
      } catch (err) {
        if (err.name === 'AbortError') return;
        displayErrorUI(err);
      } finally {
        stopSpinner();
      }
    });
}

let g:lightline = {
    \ 'component': {
    \   'filename': '%t%{exists("w:quickfix_title")? " ".w:quickfix_title : ""}'
    \   },
    \ }

NORMAL  [Quickfix List] | -

NORMAL  [Quickfix List] :ag --vimgrep --hidden --smart-case --nogroup --nocolor --column stream-name | -

(ql:quickload '(:clack :lack :lack-session-store-redis :cl-redis))

(defparameter *app*
  (lambda (env)
    (declare (ignore env))
    '(200 (:content-type "text/plain") ("Hello, World"))))

(setf *app*
      (lack:builder
        (:session
         :store (lack.session.store.redis:make-redis-store :connection (make-instance 'redis:redis-connection
                                                                                      :host #(0 0 0 0)
                                                                                      :port 6379
                                                                                      :auth "auth")))
        *app*))

> (defvar *handler* (clack:clackup *app*))
Hunchentoot server is started.
Listening on 127.0.0.1:5000.

$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
  4 threads and 10 connections

Thread: 7; Level: 1

Redis error: NIL

ERR Protocool error: invalid multibulk length
   [Condition of type REDIS:REDIS-ERROR-REPLY]

Restarts:
  R 0. ABORT - abort thread (#<THREAD "hunchentoot-worker-127.0.0.1:53815" RUNNING {100154F693}>)

Frames:
  F 0.  ((:METHOD REDIS:EXPECT ((EQL :STATUS))) #<unused argument>) [fast-method]
  F 1.  (REDIS::SET "session:fdf15f46896842bcd84ef2e87d2321e97419f70e" "KDpQQ09ERSAxICg6SEFTSC1UQUJMRSAxIDcgMS41IDEuMCBFUVVBTCBOSUwgTklMKSk=")
  F 2.  ((:METHOD LACK.MIDDLEWARE.SESSION.STORE:STORE-SESSION (LACK.MIDDLEWARE.SESSION.STORE.REDIS:REDIS-STORE T T)) #S(LACK.MIDDLEWARE.SESSION.STORE.REDIS:REDIS-STORE :HOST #(0 0 0 0) :PORT 6379 :NAMESPACE "..
  F 3.  (LACK.MIDDLEWARE.SESSION::FINALIZE #S(LACK.MIDDLEWARE.SESSION.STORE.REDIS:REDIS-STORE :HOST #(0 0 0 0) :PORT 6379 :NAMESPACE "session" :EXPIRES NIL :SERIALIZER #<FUNCTION #1=(LAMBDA (LACK.MIDDLEWARE.S..
  F 4.  ((LAMBDA (LACK.MIDDLEWARE.BACKTRACE::ENV) :IN "/Users/matteolandi/Workspace/lack/src/middleware/backtrace.lisp") (:REQUEST-METHOD :GET :SCRIPT-NAME "" :PATH-INFO "/" ...))

Thread: 8; Level: 1

Redis error: end of file on #<FLEXI-STREAMS:FLEXI-IO-STREAM {100AF94323}>
   [Condition of type REDIS:REDIS-CONNECTION-ERROR]

Restarts:
  R 0. RECONNECT - Try to reconnect and repeat action.
  R 1. ABORT     - abort thread (#<THREAD "hunchentoot-worker-127.0.0.1:53818" RUNNING {1008949253}>)

Frames:
  F 0.  (REDIS::SET "session:5b391bd4699e86f5b6e757451572c0a3ba825557" "KDpQQ09ERSAxICg6SEFTSC1UQUJMRSAxIDcgMS41IDEuMCBFUVVBTCBOSUwgTklMKSk=")
  F 1.  ((:METHOD LACK.MIDDLEWARE.SESSION.STORE:STORE-SESSION (LACK.MIDDLEWARE.SESSION.STORE.REDIS:REDIS-STORE T T)) #S(LACK.MIDDLEWARE.SESSION.STORE.REDIS:REDIS-STORE :HOST #(0 0 0 0) :PORT 6379 :NAMESPACE "..
  F 2.  (LACK.MIDDLEWARE.SESSION::FINALIZE #S(LACK.MIDDLEWARE.SESSION.STORE.REDIS:REDIS-STORE :HOST #(0 0 0 0) :PORT 6379 :NAMESPACE "session" :EXPIRES NIL :SERIALIZER #<FUNCTION #1=(LAMBDA (LACK.MIDDLEWARE.S..
  F 3.  ((LAMBDA (LACK.MIDDLEWARE.BACKTRACE::ENV) :IN "/Users/matteolandi/Workspace/lack/src/middleware/backtrace.lisp") (:REQUEST-METHOD :GET :SCRIPT-NAME "" :PATH-INFO "/" ...))
  F 4.  ((:METHOD HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST (CLACK.HANDLER.HUNCHENTOOT::CLACK-ACCEPTOR T)) #<CLACK.HANDLER.HUNCHENTOOT::CLACK-ACCEPTOR (host 127.0.0.1, port 5000)> #<HUNCHENTOOT:REQUEST {10071E47B..
  F 5.  ((:METHOD HUNCHENTOOT:HANDLE-REQUEST (HUNCHENTOOT:ACCEPTOR HUNCHENTOOT:REQUEST)) #<CLACK.HANDLER.HUNCHENTOOT::CLACK-ACCEPTOR (host 127.0.0.1, port 5000)> #<HUNCHENTOOT:REQUEST {10071E47B3}>) [fast-met..

diff --git a/src/middleware/session/store/redis.lisp b/src/middleware/session/store/redis.lisp
index 9e489d9..3ccfaec 100644
--- a/src/middleware/session/store/redis.lisp
+++ b/src/middleware/session/store/redis.lisp
@@ -54,9 +54,8 @@
 (defun redis-connection (store)
   (check-type store redis-store)
   (with-slots (host port auth connection) store
-    (unless (redis::connection-open-p connection)
-      (setf connection
-            (open-connection :host host :port port :auth auth)))
+    (setf connection
+          (open-connection :host host :port port :auth auth))
     connection))

 (defmacro with-connection (store &body body)

> (intern "chat.channels.turbo::turbo-channel")
|chat.channels.turbo::turbo-channel|

> (intern (string-upcase "chat.channels.turbo::turbo-channel"))
|CHAT.CHANNELS.TURBO::TURBO-CHANNEL|

> (read-from-string "chat.channels.turbo::turbo-channel")
CHAT.CHANNELS.TURBO::TURBO-CHANNEL

> (find-symbol (string-upcase "turbo-channel") (find-package (string-upcase "chat.channels.turbo")))
CHAT.CHANNELS.TURBO::TURBO-CHANNEL
:INTERNAL

> (make-instance *)
#<CHAT.CHANNELS.TURBO::TURBO-CHANNEL {10016892F3}>

(defun parse-entry-name (name)
  "Parses out `name' into a package and symbol name.

 eg.
  symbol          => nil, symbol
  package:symbol  => package, symbol
  package::symbol => package, symbol
"
  (let* ((colon (position #\: name))
         (package-name (when colon (subseq name 0 colon)))
         (name-start (if colon
                         (let ((second-colon (position #\: name :start (1+ colon))))
                           (if second-colon
                               (prog1 (1+ second-colon)
                                 (when (position #\: name :start (1+ second-colon))
                                   (error "invalid entry point name - too many colons: ~A" name)))
                               (1+ colon)))
                         0))
         (symbol-name (subseq name name-start)))
    (values package-name symbol-name)))

> (multiple-value-bind (package-name symbol-name)
      (parse-entry-name "chat.channels.turbo::turbo-channel")
    (find-symbol (string-upcase symbol-name)
                 (if package-name (find-package (string-upcase package-name)) *package*)))
CHAT.CHANNELS.TURBO::TURBO-CHANNEL
:INTERNAL

(defmethod initialize-instance :after ((app <app>) &key)
  (setf (gethash *package* *package-app-map*) app))

(defun find-package-app (package)
  (gethash package *package-app-map*))

(defun register-routes-package (package)
  (setf (gethash package caveman2.app::*package-app-map*) *web*))

(in-package :cl-user)
(defpackage chat.routes.sessions
  (:use :cl :caveman2 :chat.models :chat.views :chat.routes))
(in-package :chat.routes.sessions)
(register-routes-package *package*)

(defroute "/" ()
  (if (current-user)
    (redirect-to (default-chatroom))
    (render :new :user)))

// webpack.config.json

...
class MetaInfoPlugin {
  constructor(options) {
    this.options = { filename: 'meta.json', ...options };
  }

  apply(compiler) {
    compiler.hooks.done.tap(this.constructor.name, stats => {
      const files = {};
      for (let filename of Object.keys(stats.compilation.assets)) {
        const parts = filename.split(/\./);
        const extension = parts[parts.length - 1];
        if (!files[extension]) {
          files[extension] = [ filename ];
        } else {
          files[extension].push(filename);
        }
      }
      const metaInfo = {
        files,
      };
      const json = JSON.stringify(metaInfo);
      return new Promise((resolve, reject) => {
        fs.writeFile(this.options.filename, json, 'utf8', error => {
          if (error) {
            reject(error);
            return;
          }
          resolve();
        });
      });
    });
  }
}
...

  plugins: [
    ...
    new MetaInfoPlugin({ filename: 'static/dist/meta.json' }),
  ],
...

$ cat static/dist/meta.json | json_pp
{
   "files" : {
      "css" : [
         "app-26d385c021c0729b47ba.css"
      ],
      "js" : [
         "app-8f5ff9499dfe4b9fa887.js",
         "vendor~app-300b96fb7678a6c52a50.js"
      ],
      "map" : [
         "app-26d385c021c0729b47ba.css.map",
         "app-8f5ff9499dfe4b9fa887.js.map",
         "vendor~app-300b96fb7678a6c52a50.js.map"
      ]
   }
}

(defparameter *webpack-meta* (merge-pathnames #P"dist/meta.json" *static-directory*))
(defparameter *webpack-assets* (st-json:read-json (uiop:read-file-string *webpack-meta*)))

(defun webpack-assets ()
  (with-html
    (loop for css in (st-json:getjso* "files.css" *webpack-assets*)
          do (:link :rel "stylesheet" :href (format nil "/dist/~A" css) :data-turbo-track "reload"))
    (loop for js in (st-json:getjso* "files.js" *webpack-assets*)
          do (:script :src (format nil "/dist/~A" js) :data-turbo-track "reload")) ))

(defmacro with-page ((&key (title "Chat!")) &body body)
  `(with-html-string
    (:doctype)
    (:html
     (:head
      (:title ,title)
      (webpack-assets))
     (:body ,@body))))

<!DOCTYPE html>
<html lang=en>
 <head>
  <meta charset=UTF-8>
  <title>Chat!</title>
  <link rel=stylesheet
        href=/dist/app-26d385c021c0729b47ba.css
        data-turbo-track=reload>
  <script src=/dist/app-8f5ff9499dfe4b9fa887.js
          data-turbo-track=reload></script>
  <script
          src=/dist/vendor~app-300b96fb7678a6c52a50.js
          data-turbo-track=reload></script>
 </head>
 <body>
 ...

(foo |)-close|)
|     `-- highlighted
`-- cursor position

(foo |)-close|)
|             `-- highlighted
`-- cursor position

if !empty(g:lispindent_filetypes)
  augroup lispindent_filetypes
    autocmd!
    execute 'autocmd FileType ' . g:lispindent_filetypes . ' call lispindent#init()'
  augroup END
endif

if !empty(g:lispindent_filetypes)
  " augroup lispindent_filetypes
  "   autocmd!
  "   execute 'autocmd FileType ' . g:lispindent_filetypes . ' call lispindent#init()'
  " augroup END
endif

(defun hello-world()
  (format t "Hello, world!"))

(defun open-parenthesis-p (ch)
  "Some documentation containing unbalanced ("
  (char= ch #\())

(defun close-parenthesis-p (ch)
  "Some documentation containing unbalanced )"
  (char= ch #\)))

(defun open-parenthesis-yoda-p (ch)
  "Some documentation containing unbalanced ("
  (char= #\( ch))

(defun close-parenthesis-yoda-p (ch)
  "Some documentation containing unbalanced )"
  (char= #\) ch))

exampleWithNumber: x

"A method that illustrates every part of Smalltalk method syntax
except primitives. It has unary, binary, and keyword messages,
declares arguments and temporaries, accesses a global variable
(but not and instance variable), uses literals (array, character,
symbol, string, integer, float), uses the pseudo variables
true false, nil, self, and super, and has sequence, assignment,
return and cascade. It has both zero argument and one argument blocks."

    |y|
    true & false not & (nil isNil) ifFalse: [self halt].
    y := self size + super size.
    #($a #a "a" 1 1.0)
        do: [:each | Transcript show: (each class name);
                                 show: ' '].
    ^ x < y

const { Transform } = require("stream");
class MyTransformStream extends Transform {
  constructor(options) {
    super(options);
    this._res = new asyncHooks.AsyncResource("MyTransformStream");
  }
  _transform(chunk, encoding, cb) {
    this._res.runInAsyncScope(cb, null, null, chunk);
  }
}

const myStream = new MyTransformStream();
var repl = require("repl").start({
  input: socket.pipe(myStream), // created within your async scope so ALS propagation works
  output: socket,
});

net
  .createServer(function (socket) {
    ctx.run((reqId += 1), () => {
      const onOriginal = socket.on;
      socket.on = function onHooked(data, callback) {
        let callbackHooked = asyncHooks.AsyncResource.bind(callback, "REPL");
        // The result of `AsyncResource.bind` is a function expecting
        // its first argument to be `thisArg`, so to properly finish up
        // the wiring we need to bind it before actually using the transformed
        // callback
        callbackHooked = callbackHooked.bind(this, this);
        return onOriginal.apply(socket, [data, callbackHooked]);
      };

      const repl = require("repl").start({ input: socket, output: socket });
      repl.context.ctx = ctx;
      debug("Created repl", ctx.getStore());
    });
  })
  .listen(8081);
debug("Listening on port 8081");

$ node --version
v14.16.0
$ node async_bug.js
Listening on port 8081

$ nc localhost 8081
> ctx.getStore()
undefined

$ node async_bug.js
Listening on port 8081
Connected 1
[undefined] on-data from-1

Connected 2
[undefined] on-data from-2

net
  .createServer(function (socket) {
    ctx.run((reqId += 1), () => {
      const res = new asyncHooks.AsyncResource("REPL");
      debug("Connected", ctx.getStore());
      socket.on("data", (data) => {
        res.runInAsyncScope(
          () => {
            debug(`[${ctx.getStore()}]`, "on-data", data.toString());
          },
          this,
          data
        );
      });
    });
  })
  .listen(8081);
debug("Listening on port 8081");

$ node async_bug.js
Listening on port 8081
Connected 1
[1] on-data from-1

Connected 2
[2] on-data form-2

net
  .createServer(function (socket) {
    ctx.run((reqId += 1), () => {
      const res = new asyncHooks.AsyncResource("REPL");
      const repl = require("repl").start({ input: null, output: null });
      socket.on("data", (data) => {
        res.runInAsyncScope(
          () => {
            repl.input.emit("data", data);
          },
          this,
          data
        );
      });
      repl.context.ctx = ctx;
      debug("Created repl", ctx.getStore());
    });
  })
  .listen(8081);
debug("Listening on port 8081");

$ node async_bug.js
Listening on port 8081
> Created repl 1
ctx.getStore()
1
> Created repl 2
ccttx..etStore(())
2
>
2

var asyncHooks = require("async_hooks");
var fs = require("fs");
var util = require("util");
var net = require("net");

function debug(...args) {
  fs.writeFileSync(1, `${util.format(...args)}\n`, { flag: "a" });
}

var ctx = new asyncHooks.AsyncLocalStorage();
var reqId = 0;

net
  .createServer(function (socket) {
    ctx.run((reqId += 1), () => {
      var repl = require("repl").start({
        input: socket,
        output: socket,
      });
      repl.context.ctx = ctx;
      debug("Created repl", ctx.getStore());
    });
  })
  .listen(8081);
debug("Listening on port 8081");

$ node remote-repl.js
Listening on port 8081

$ nc localhost 8081
>

> ctx
AsyncLocalStorage {
  kResourceStore: Symbol(kResourceStore),
  enabled: true
}
> ctx.getStore()
undefined

net
  .createServer(function (socket) {
    ctx.run((reqId += 1), () => {
      debug("Connected", ctx.getStore());
      socket.on("data", (data) => {
        debug(`[${ctx.getStore()}]`, "on-data", data.toString());
      });
    });
  })
  .listen(8081);

(defparameter *x* 5)

(defun rebind ()
  (setf *x* 15))

(defun test1 ()
  "We create a new _frame_ for *x*, so all the SETF operations affect that"
  (let ((*x* 10))
    (rebind)
    (assert (= *x* 15)))
  (assert (= *x* 5)))

(test1)
(assert (= *x* 5))

(defun test2 ()
  "LET here does not create a new _frame_ for *x*, so SETF ends up actually
  changing the _global_ value"
  (let ((whatever 10))
    (rebind)
    (assert (= *x* 15)))
  (assert (= *x* 15)))

(test2)
(assert (= *x* 15))

(defun test3 ()
  "We don't even create a new _frame_ for *x*...so this behaves like TEST2"
  (rebind)
  (assert (= *x* 15)))

(setf *x* 5)
(test3)
(assert (= *x* 15))

var DynamicEnvironment = function (...flatBindings) {
  this.globalFrame = new Bindings(parseKVPairs(flatBindings));
  this.dynamicFrames = new AsyncLocalStorage();
};

var Bindings = function (kvpairs) {
  this.data = new Map(kvpairs);
};
Bindings.prototype.get = function (name) {
  if (!this.has(name)) {
    throw new Error(`Dynamic variable, unbound: '${name.toString()}'`);
  }
  return this.data.get(name);
};
Bindings.prototype.has = function (name) {
  assert.ok(name, `Dynamic variable name, invalid: ${name.toString()}`);
  return this.data.has(name);
};
Bindings.prototype.set = function (key, value) {
  return this.data.set(key, value);
};
Bindings.prototype[Symbol.iterator] = function () {
  return this.data[Symbol.iterator]();
};

DynamicEnvironment.prototype.get = function (name) {
  return this.findBindingFrameOrGlobal(name).get(name);
};
DynamicEnvironment.prototype.findBindingFrameOrGlobal = function (name) {
  let frame;
  for (let each of this.dynamicFrames.getStore() || []) {
    if (each.has(name)) {
      frame = each;
      break;
    }
  }
  return frame || this.globalFrame;
};

DynamicEnvironment.prototype.set = function (...args) {
  const updatesExistingFrames = args.length % 2 === 0;
  if (updatesExistingFrames) {
    for (let [key, value] of parseKVPairs(args)) {
      this.findBindingFrameOrGlobal(key).set(key, value);
    }
  } else {
    const kvpairs = parseKVPairs(args.slice(0, args.length - 1));
    const body = args[args.length - 1];
    const bindings = new Bindings(kvpairs);
    return this.dynamicFrames.run(
      [bindings, ...(this.dynamicFrames.getStore() || [])],
      body
    );
  }
};

DynamicEnvironment.prototype[Symbol.iterator] = function () {
  const bindings = new Map(this.globalFrame);
  for (let frame of (this.dynamicFrames.getStore() || []).reverse()) {
    for (let [key, value] of frame) {
      bindings.set(key, value);
    }
  }
  return bindings[Symbol.iterator]();
};

var env = new DynamicEnvironment('debug', false);

function timer() {
  console.log(env.get('debug'))
}

var tid = setInterval((...args) => timer(...args), 2000);

var net = require("net");
var repl = require("repl");

function createREPL(socket) {
  console.log("Connection received; creating a REPL!");
  const remote = repl.start({
    prompt: "remote> ",
    input: socket,
    output: socket,
    useGlobal: true,
  });
}

var server = net.createServer((...args) => createREPL(...args));
server.listen(5001, "localhost");
console.log("Remote REPL started on port 5001");

$ nc localhost 5001
remote> env
DynamicEnvironment {
  globalFrame: Bindings { data: Map(1) { 'debug' => false } },
  dynamicFrames: AsyncLocalStorage {
    kResourceStore: Symbol(kResourceStore),
    enabled: false
  }
}

remote> env.set('debug', true)

env.set('logfile', '/tmp/server.log', 'debug', false);

function timer() {
  env.set("logfile", "/tmp/different.log", "date", new Date(), () =>
    setTimeout(() => {
      console.log(env[Symbol.iterator]());
    }, 500)
  );
}

...
[Map Entries] {
  [ 'debug', false ],
  [ 'logfile', '/tmp/different.log' ],
  [ 'date', 2021-03-12T19:37:59.963Z ]
}
...

remote> env.set('debug', true)

...
[Map Entries] {
  [ 'debug', true ],
  [ 'logfile', '/tmp/different.log' ],
  [ 'date', 2021-03-12T19:40:54.317Z ]
}
...

(define (attach-tag type-tag contents)
  (cons type-tag contents))
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "Bad tagged datum -- TYPE-TAG" datum)))
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "Bad tagged datum -- CONTENTS" datum)))

(define (rectangular? z)
  (eq? (type-tag z) 'rectangular))
(define (polar? z)
  (eq? (type-tag z) 'polar))

(define (real-part-rectangular z) (car z))
(define (imag-part-rectangular z) (cdr z))
(define (magnitude-rectangular z)
  (sqrt (+ (square (real-part-rectangular z))
           (square (imag-part-rectangular z)))))
(define (angle-rectangular z)
  (atan (imag-part-rectangular z)
        (real-part-rectangular z)))
(define (make-from-real-imag-rectangular x y)
  (attach-tag 'rectangular (cons x y)))
(define (make-from-mag-ang-rectangular r a)
  (attach-tag 'rectangular
              (cons (* r (cos a)) (* r (sin a)))))

;; similar definitions for the "polar" representation

(define (real-part z)
  (cond ((rectangular? z)
         (real-part-rectangular (contents z)))
        ((polar? z)
         (real-part-polar (contents z)))
        (else (error "Unknown type -- REAL-PART" z))))
(define (imag-part z)
  (cond ((rectangular? z)
         (imag-part-rectangular (contents z)))
        ((polar? z)
         (imag-part-polar (contents z)))
        (else (error "Unknown type -- IMAG-PART" z))))
(define (magnitude z)
  (cond ((rectangular? z)
         (magnitude-rectangular (contents z)))
        ((polar? z)
         (magnitude-polar (contents z)))
        (else (error "Unknown type -- MAGNITUDE" z))))
(define (angle z)
  (cond ((rectangular? z)
         (angle-rectangular (contents z)))
        ((polar? z)
         (angle-polar (contents z)))
        (else (error "Unknown type -- ANGLE" z))))

(define (install-rectangular-package)
  ;; internal procedures
  (define (real-part z) (car z))
  (define (imag-part z) (cdr z))
  (define (make-from-real-imag x y) (cons x y))
  (define (magnitude z)
    (sqrt (+ (square (real-part z))
             (square (imag-part z)))))
  (define (angle z)
    (atan (imag-part z) (real-part z)))
  (define (make-from-mag-ang r a)
    (cons (* r (cos a)) (* r (sin a))))
  ;; interface to the rest of the system
  (define (tag x) (attach-tag 'rectangular x))
  (put 'real-part '(rectangular) real-part)
  (put 'imag-part '(rectangular) imag-part)
  (put 'magnitude '(rectangular) magnitude)
  (put 'angle '(rectangular) angle)
  (put 'make-from-real-imag 'rectangular
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'rectangular
       (lambda (r a) (tag (make-from-mag-ang r a))))
  'done)