Joshua Munn's Website

About

You can contact me via public at elysee dash munn dot family. Ed and I live in Hertfordshire, UK - if you are a friend or family member from abroad and visiting the UK get in touch.

I run a matrix server for family and friends. If you would like an invite send me an email.

I'm on github.

Here are some blog posts I've written, mostly about programming:

Posts

[2022-11-23 Wed] - Emacs Lisp in Haskell

For a long time, since first migrating from OSX to Linux, I have been a user of the dwm tiling window manager. It is great software, my thanks to the authors. Lately, however, I've had an itch to change things up. I've been spending some time learning Haskell, so Xmonad is an obvious choice.

Disclaimer: I am a Haskell beginner, and the Haskell snippets in this post will likely reflect that fact.

I like my window manager to have keybindings that allow me to open Emacs frames1 containing specific files or tools, so I can conveniently:

  • view my agenda;
  • use M-x calc;
  • create a new to-do action with org-capture;

and so on.

xmonad-contrib has a great submap module, which enables behaviour that will be familiar to Emacs users (and similar to leader-key functionality in Vim).

myKeys =
  [ ( (winKey, xK_e),
      submap . Map.fromList $
        [ ( (0, xK_c),
            spawn $ getEmacsClientCommand emacsClientDefaults
          ),
          ( (0, xK_equal),
            spawn $ getEmacsClientCommand emacsCalcArgs
          ),
          ( (0, xK_a),
            spawn $ getEmacsClientCommand orgAgendaArgs
          )
          -- etc. ...
        ]
    )
  ]

With the above declaration, I can activate my "Emacs submap" by pressing M-e (Windows key + "e"), then trigger some action dependent on the next keypress. For example, M-e followed by = will spawn a new Emacs frame with calc ready to go.

I like to run Emacs as a daemon, and use emacsclient to edit. A typical invocation to edit a file in a new frame looks like this:

emacsclient --create-frame /path/to/my-file  

emacsclient also lets you evaluate arbitrary Emacs Lisp (Elisp). For example, to create a new frame with calc maximised, I could execute:

emacsclient --create-frame --eval "(full-calc)"

This begins to get a little hairy when passing strings, as quote-marks and backslashes in strings need escaping, eg.:

emacsclient --create-frame --eval "(org-tags-view nil \"TODO=\\\"NEXT\\\"\")"

The obvious solution is to encapsulate options and logic in Elisp functions, and call those functions directly from --eval, so I only need to pass simple Elisp forms to emacsclient. However, my "I wonder if I can…" instinct is triggered by the possibility of an embedded language.

String → ElispExpr: Parsing (a very small subset of) Emacs Lisp

I would like to be able to write Emacs Lisp directly in my Xmonad config file, and have it transformed to Haskell data types so I can programatically generate the program strings to pass to emacsclient for evaluation. Conveniently, GHC (the Glasgow Haskell Compiler) has extensions for compile-time metaprogramming - namely, TemplateHaskell and QuasiQuotes.

Quasi-quoters allow us to embed arbitrary syntax in a Haskell source file, so long as we transform it to valid Haskell syntax. To represent an Elisp program in Haskell, I define the following data type:

data ElispExpr
  = EString String
  | ESymbol String
  | EQuoted ElispExpr
  | EList [ElispExpr]
  | EDot
  deriving (Show, Data)

This datatype says that an expression in Elisp is either an atom (a string or a symbol) or a list of atoms. This is not exactly representative of a Lisp program, and is probably more fairly compared to a representation of S-expressions. There's no distinction between lists and function application, and EDot (the dot used in pair syntax, e.g. (foo . bar)) isn't really an atom. But, for my purposes it will work.

We need a parser, to take a String and transform it to an ElispExpr. I used the megaparsec parser combinator2 library. megaparsec has a very thorough tutorial here, so I will not go into details. The parser itself is quite short, so I will reproduce it in full:

type ElispParser = Parsec Void String

-- consume space
sc :: ElispParser ()
sc = L.space space1 empty empty

-- parse a lexeme and consume trailing spaces
lexeme :: ElispParser String -> ElispParser String
lexeme = L.lexeme sc

-- takes a string, returns a parser that matches that string
symbol :: String -> ElispParser String
symbol = L.symbol sc

-- takes a parser, returns a parser that succeeds if that parser
-- is surrounded by parens
parens :: ElispParser a -> ElispParser a
parens = between (symbol "(") (symbol ")")

-- valid chars that make up a symbol
symChar :: ElispParser Char
symChar =
  alphaNumChar
    <|> char '!'
    <|> char '#'
    <|> char '@'
    <|> char '$'
    <|> char '%'
    <|> char '^'
    <|> char '&'
    <|> char '*'
    <|> char '_'
    <|> char '-'
    <|> char '+'
    <|> char '='
    <|> char '/'
    <|> char '<'
    <|> char '>'

-- parse a string literal
eStringLiteral :: ElispParser ElispExpr
eStringLiteral =
  Elisp.lexeme (char '\"' *> manyTill L.charLiteral (char '\"'))
    <&> EString

-- parse a symbol, e.g. a variable name
eSymbol :: ElispParser ElispExpr
eSymbol = Elisp.lexeme (some symChar) <&> ESymbol

-- parse a symbol or a string literal
eAtom :: ElispParser ElispExpr
eAtom = eSymbol <|> eStringLiteral

-- parse the '.' character - discards the input
eDot :: ElispParser ElispExpr
eDot = Elisp.symbol "." >> return EDot

-- parse an expression preceded by the single quote
eQuoted :: ElispParser ElispExpr
eQuoted = char '\'' *> (eAtom <|> eList) <&> EQuoted

-- parse a list
eList :: ElispParser ElispExpr
eList = parens (many (eAtom <|> eQuoted <|> eDot <|> eList)) <&> EList

-- top-level parser, parse an expression
elispExpr :: ElispParser ElispExpr
elispExpr = eQuoted <|> eAtom <|> eList

This is a quick-and-dirty parser, but the brevity and readability of combinatorial parsers is evident. I have omitted code that exists to improve error messages from this reproduction to make the structure of the parser clearer.

We now have a way to take a string of Elisp and turn it into a Haskell representation of our Elisp program. The final step towards being able to write Elisp inline in Haskell source is defining a QuasiQuoter.

elisp :: QuasiQuoter
elisp =
  QuasiQuoter
    { quoteExp = \s ->
        -- use `sc' to consume leading space
        case runParser (sc *> elispExpr) "" s of
          Left err -> error $ errorBundlePretty err
          Right expr -> liftData expr,
    }

Because we derived Data on the ElispExpr type, we can use liftData to take care of some necessary processing, and end up with our Elisp source transformed to ElispExprs in our Haskell program. Neat! A quasi-quoted Elisp expression, such as the following:

orgNextActionsCommand =
  [elisp|
(let ((org-agenda-window-setup 'only-window))
  (org-tags-view nil "TODO=\"NEXT\""))
|]

will be encoded in our Haskell program as:

EList
  [ ESymbol "let",
    EList
    [ EList
      [ ESymbol "org-agenda-window-setup",
        EQuoted (ESymbol "only-window")
      ]
    ],
    EList
    [ ESymbol "org-tags-view",
      ESymbol "nil",
      EString "TODO=\"NEXT\""
    ]
  ]

ElispExpr → String

To use our Haskell-encoded Elisp program as an argument to emacsclient, we need to render it back to a string. For this I defined a prettyPrint function.

prettyPrint :: ElispExpr -> String
prettyPrint (EString s) = show s
prettyPrint (ESymbol s) = s
prettyPrint EDot = "."
prettyPrint (EQuoted e) = "'" ++ prettyPrint e
prettyPrint (EList es) = "(" ++ unwords (map prettyPrint es) ++ ")"

Putting it together

To encapsulate the arguments to an emacsclient invocation, I created an EmacsClientArgs datatype.

data EmacsClientArgs = EmacsClientArgs
  { emacsClientEval :: ElispExpr,
    emacsClientFrameParams :: ElispExpr,
    emacsClientFile :: String
  }

emacsClientDefaults :: EmacsClientArgs
emacsClientDefaults =
  EmacsClientArgs
    { emacsClientEval = [elisp|()|],
      emacsClientFrameParams = [elisp|()|],
      emacsClientFile = ""
    }

To take care of putting it all together, I use toArgString.

class ToArgString a where
  toArgString :: a -> String

instance ToArgString EmacsClientArgs where
  toArgString args =
    let eval = case emacsClientEval args of
          EList [] -> ""
          expr -> "--eval " ++ show (prettyPrint expr)
        frameParams = case emacsClientFrameParams args of
          EList [] -> ""
          expr -> "--frame-parameters " ++ show (prettyPrint expr)
        file = emacsClientFile args
     in unwords [eval, frameParams, file]

So, with the following definitions:

orgAgendaEval =
  [elisp|
(let ((org-agenda-window-setup 'only-window))
  (org-agenda-list))
|]

orgAgendaArgs :: EmacsClientArgs
orgAgendaArgs =
  emacsClientDefaults
    { emacsClientEval = orgAgendaEval,
      emacsClientFrameParams = [elisp|((name . "*Org Agenda*"))|]
    }

We can generate the following string:

ghci> toArgString orgAgendaArgs
"--eval \"(let ((org-agenda-window-setup 'only-window)) (org-agenda-list))\" --frame-parameters \"((name . \\\"*Org Agenda*\\\"))\" "

Being able to write Elisp directly in my Xmonad config feels good. I would, of course, write anything remotely complex in my Emacs config, or an Emacs package, but for experimenting with short snippets this is convenient!

Inline elisp-mode in Haskell buffers!

My next line of thought was that it would be cool to get Elisp syntax highlighting in the elisp quasi-quoter in my Xmonad config. Having used web-mode I was sure there would be a way, and as it turns out polymode makes this fairly straightforward. With the following polymode definition:

(define-hostmode poly-haskell-hostmode
  :mode nil)

(define-innermode poly-haskell-elisp-innermode
  :mode 'emacs-lisp-mode
  :head-matcher "\\[elisp|\n?"
  :tail-matcher "|\\]"
  :head-mode 'host
  :tail-mode 'host)

(define-polymode poly-haskell-mode
  :hostmode 'poly-haskell-hostmode
  :innermodes '(poly-haskell-elisp-innermode))

Elisp quasi-quoter regions are treated as distinct buffers running under elisp-mode! The following screenshot (apologies for the picture of text) shows a portion of my Xmonad config, with Prot's ef-summer theme, using the polymode. With this minor-mode activated I get Elisp syntax highlighting, indentation and code completion inline in the Haskell buffer.

EmacsYiejUp.svg

Issues

When launching an emacsclient frame via Xmonad, I like to have some particular frames open in specific window layouts. For example, org-capture and org-agenda should open in a floating, centered window. As these buffers are created by calling an Elisp function, the initial title of the X window does not match the name of the frame that you see when you load the org-agenda buffer, i.e. "*Org Agenda*". To get around this, we can use the --frame-parameters option to emacsclient to give the frame a specific name.

orgAgendaArgs =
  emacsClientDefaults
    { emacsClientEval = orgAgendaEval,
      emacsClientFrameParams = [elisp|((name . "*Org Agenda*"))|]
    }

Now we can match on the name in the manageHook:

myManageHook =
  composeAll
    [ title =? "*Org Agenda*" --> doCenterFloat
      -- ... etc
    ]

[2022-04-27 Wed] - microKanren, cons, and Python (part I)

I've been implementing µKanren3 in Python. One challenge so far has been creating a sequence abstraction with semantics similar to Lisp lists. This is important as it's necessary to be able to decompose sequences into parts for unification, such that:

  1. I can get the first element of a sequence;
  2. I can get the rest of the sequence; and
  3. the "rest" of the sequence might be a sequence or a non-iterable value (including logic variables).

Cons

The ubiquitous data structure in Lisp-like languages is a two part cell known as a cons or a pair. It can be thought of as a struct with two fields, instances of which are created using the function cons. Conceptually, (cons 1 2) yields the pair containing 1 in its first part and 2 in its second part.

┌───┬───┐
│ 1 ┊ 2 │
└───┴───┘
(cons 1 2)

Lists are composed of pairs - a proper list is a pair in which the second part contains either a proper list or the empty list.

(cons 1 (cons 2 (cons 3 '()))) creates the list containing 1, 2, and 3 4, 5:

┌───┬───┐  ┌───┬───┐  ┌───┬───┐  
│ 1 ┊ ╾────┤ 2 ┊ ╾────┤ 3 ┊ ∅ │
└───┴───┘  └───┴───┘  └───┴───┘  
A proper list

┌───┬───┐  ┌───┬───┐
│ 1 ┊ ╾────┤ 2 ┊ 3 │
└───┴───┘  └───┴───┘
An improper list (not terminated by the empty list)

Python

Getting back to Python: first you might try to emulate the behaviour of Lisp lists using the builtin list (or tuple), which meets our first two criteria and can be conveniently decomposed with unpacking assignments:

the_list = [1, 2, 3, 4]
first, *rest = the_list  # also the_list[0], the_list[1:]
first, rest
(1, [2, 3, 4])

This unfortunately fails the third criteria - I want to be able to get the "rest" of the list, allowing the "rest" to be a list or something else.

I would like to be able to construct a sequence such that the terminating element is some entity that represents that the sequence is not yet fully instantiated - I don't know what the rest of the sequence is, yet - but it may become a proper sequence at some point in time. That last sentence seems a little "spooky" in the Fox Mulder sense, so here's an example:

  1. (1, 2, 3 ? x) represents a sequence in which the suffix is unknown;
  2. if at some point in time x is found to represent the sequence (4, 5), the original sequence is now known to be (1, 2, 3, 4, 5);
  3. if x is found to represent the single element 4, the sequence is now known to be (1, 2, 3, 4); and
  4. if x is found to represent the empty sequence, the sequence is now known to be (1, 2, 3).

A new data type

One could try to conditionally handle the retrieval of the "rest" part of a sequence everywhere it is needed, but I think a cleaner approach is to encapsulate the desired behaviour in a new data type. My first attempt was a class that encapsulated the semantics of unpacking assignments, UnpackingAssignment. It looked something like this:

class UnpackingAssignment:
    def __init__(self, *heads, glob=None, rest=None):
        self.heads = heads
        self.glob = glob
        self.rest = rest

pack = UnpackingAssignment  # conflicting naming, but it's a convenient shorthand

pack(1, 2, glob=[3, 4], rest=[5])  # a, b, *c, d = [1,2,3,4,5]

pack(glob=[3, 4], rest=[5, 6])  # *a, b, c = [3,4,5,6]

pack(1, glob=[2, 3])  # a, *b = [1,2,3]

The variadic nature of the fields makes unification tricky, particularly once you add logic variables and arbitrarily deeply nested structures into the mix. One area of difficulty is unifying UnpackingAssignment instances that contain "overlapping" fields. In the following examples, variable names represent logic variables, represents unification, and { u₀ ↦ v₀, u₁ ↦ v₁, ... } represents the resulting set of mappings.

Some simple cases:

  • pack(1, glob=x) ≡ [1, 2, 3]
    • { x ↦ [2, 3] }
  • pack(x, glob=[2, 3]) ≡ [1, 2, 3]
    • { x ↦ 1 }
  • pack(glob=x, heads=[3]) ≡ [1, 2, 3]
    • { x ↦ [1, 2]}
  • pack(x, glob=[2, 3], rest=[y]) ≡ [1, 2, 3, 4]
    • { x ↦ 1, y ↦ 4 }

And some more interesting ones:

  • pack(1, glob=x, rest=y) ≡? [1, 2, 3, 4]
    • intuition says that the set of results should be:
      • { x ↦ [], y ↦ [1, 2, 3, 4] }
      • { x ↦ [1], y ↦ [2, 3, 4] }
      • { x ↦ [1, 2], y ↦ [3, 4] } (and so on)
  • pack(1, 2, glob=x, rest=[4, 5]) ≡? pack(1, glob=y, pack(glob=x, rest=[4, 5]))
    • intuitively these terms should unify with { x ↦ [3], y ↦ [2] }
  • pack(x, glob=[2, 3, 4], rest=[5, 6, 7]) ≡? pack(1, 2, glob=[3], rest=y)
    • again, there is an intuitive set of results ({ x ↦ 1, y ↦ [4, 5, 6, 7] }), but translating these intuitions into an implementation feels a bit like solving the Towers of Hanoi in the dark.

[2022-04-11 Mon] - A miniKanren quine

Here's a miniKanren quine that runs on the miniKanren implementation from The Reasoned Schemer:

((lambda (_)
   (run* x
     (conde
       ((≡ x _))
       ((≡ x (list 'quote _))))))
 '(lambda (_)
    (run* x
      (conde
        ((≡ x _))
        ((≡ x (list 'quote _)))))))

Depending on how one interprets the rules, the quine posted below may not qualify. From Wikipedia:

A quine is a computer program which takes no input and produces a copy of its own source code as its only output.

If you take output to mean something like "textual data written to a file", then it does satisfy the criteria. However, if you extend output to mean "the result of evaluation", it does not, as the result of evaluation is:

('(q:={q!r},print(f{q!r}))', None)

I guess this is indicative of differences between Python and languages in the Lisp family. The miniKanren quine above plays loose with line breaks, in the spirit of its output being the result of evaluating it in a REPL.

[2022-04-09 Sat] - A Python quine

Here's a Python 3 quine I wrote:

(q:='(q:={q!r},print(f{q!r}))',print(f'(q:={q!r},print(f{q!r}))'))

Footnotes:

1

In this post I refer to frames and windows. In the context of Emacs, a frame is what most computer users would think of as a "window" in their graphical desktop environment, and a window is like a "pane" within the frame. See the Emacs manual for more detail.

2

For a comprehensive introduction to Monadic Parser Combinators that reads like a tutorial, Graham Hutton and Erik Meijer's paper is hard to beat.

3

the (very readable) paper, hosted by William Byrd