goose121

;; (defvar *unquote** (make-symbol "UNQUOTE*"))
(defvar *unquote** :unquote*)
(defvar *unquote-splicing** :unquote-splicing*)
(defvar *qq-quote* (make-symbol "QUOTE"))
(defvar *qq-list* (make-symbol "LIST"))
(defvar *qq-append* (make-symbol "APPEND"))
(defvar *quasiquote** 'quasiquote*)

;; Taken from On Lisp

goose121

;;; Copyright github.com/goose121, released under CC0

(defun sort-plist (plist &key (test #'<) (key #'cadr))
  (labels
      ((split (plist)
         (loop :for half :on (cdr plist) :by #'cddr
               :for whole :on (cddddr plist) :by #'cddddr
               :finally (return (values plist (shiftf (cdr half) nil)))))
       (plist-merge (p1 p2)
         (loop :with res =

goose121

(defun fuel-for-mass (mass)
  (- (floor mass 3) 2))

(defun total-fuel-for-mass (mass)
  (loop :for current-mass = (fuel-for-mass mass)
          :then (fuel-for-mass current-mass)
        :until (minusp current-mass)
        :sum current-mass))

(defun part-2 (stream)

goose121

type Register = Char

data RValue = Reg Register | Imm Int
  deriving Show

data Instruction
  = Snd RValue
  | Set Register RValue
  | Add Register RValue
  | Mul Register RValue

goose121

(defun change-class-slot-workaround (old-class new-class)
  "Allow CHANGE-CLASS to convert instances of OLD-CLASS to NEW-CLASS
without invoking undefined behaviour if a slot in OLD-CLASS contains a
value incompatible with the type of that slot in NEW-CLASS. Due to the
way this function works, any slots common to OLD-CLASS and NEW-CLASS
will be unbound in the instance once its class has been changed, but
will still be present in the copy of the instance which is passed into
UPDATE-INSTANCE-FOR-DIFFERENT-CLASS.

This is done by defining two methods. The first is a primary method on

goose121

{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module EitherS
  ( EitherS(EitherS)
  , runEitherS ) where

import Control.Applicative (Alternative, empty, (<|>))
import Data.Bifunctor (first)

goose121

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE StandaloneDeriving #-}

data Axis = XAxis | YAxis

type family OtherAxis a where
  OtherAxis XAxis = YAxis

goose121

(defmacro always-accum-helper (stash-var)
  `(setf ,stash-var ,iter::*result-var*))

(defmacro always-accum ((acc &rest acc-args) &body body)
  (multiple-value-bind (iter-name body)
      (if (symbolp (car body))
          (values (car body) (cdr body))
          (values nil body))
    (with-gensyms (stash-result-var)
      `(let ((,stash-result-var nil))

goose121

(defun member-if* (test list &key (key #'identity))
  "Does the same thing as MEMBER-IF."
  (loop :for sublist :on list
        :if (funcall test (funcall key (car sublist)))
          :return sublist))

(define-setf-expander member-if* (test list &key (key #'identity) &environment env)
  (with-gensyms (store-var found-cons test-sym list-sym key-sym sublist prev-sublist)
    (multiple-value-bind (list-vars list-vals list-stores list-set list-get)
        (get-setf-expansion list env)

goose121

(defun parse-dispatch-macro-backwards ()
  (let ((old-point (point)))
    (if (save-match-data
         (and (not (member (char-before) '(?\( ?#)))
          (re-search-backward "#[0-9]*" nil t)
          (= (match-end 0) (- old-point 1))))
        (point)
        (goto-char old-point)
        nil)))