Of the Just Shaping of Letters

I stumbled across a print copy of Dürer's Of the Just Shaping of Letters in a second-hand bookshop years ago. This slim book — an English translation of part of book three of Dürer's Applied Geometry from 15351 — contains descriptions of how to draw uppercase Latin letters2. Each letter is described as a series of geometric instructions and relationships within the containing square.

As far as I am aware, Dürer is not known as a typographer per se, these letter forms are presented as a description of a how letters may be formed, rather than as a description of a specific designed typeface, they seem to be intended for an audience designing monumental stonework rather than cutting typefaces.

My interest is particularly piqued because the descriptions are close to being algorithms for each letter, the geometric instructions amount to a constraints system.

Earlier this summer I transcribed each letter into JavaScript, and over the last few days ported that to CoffeeScript (mostly just because, and what better thing to do on a Hawai’ian beach in between stand up paddle boarding and drinking daiquiris). The original lacks descriptions for J, U, and W because they weren’t/aren’t Latin letters - but I added versions. Several of the letters have variants, I only chose one in most cases.

As an example, here is the original description of the letter ‘V’ — chosen to be a short description, but not too short!

V you shall thus make in its square: Bisect c. d. in the point e.; then set the point f. one-tenth of the whole line a. b. beyond a., and in like fashion g. to the hither side of b. Then draw the broad limb of your letter downwards from f. to e. and sharpen it; & thence draw upwards your slender limb to g.; and at the top produce it in either direction, as you did before at the bottom of A; just as you see it shown below.

The CoffeeScript is not quite as pithy, but is also doing a little more housekeeping...

  drawV: (id, variant, proportions) ->
    outline = new OutlineDrawer sys.ctx

    outline.drawLine @labels.a, @labels.b
    outline.drawLine @labels.c, @labels.d
    outline.drawLine @labels.a, @labels.c
    outline.drawLine @labels.b, @labels.d

    @labels.e = midPoint @labels.c, @labels.d
    @labels.f = @labels.a.towards @labels.b, @serif
    @labels.g = @labels.b.towards @labels.a, @serif

    ll_tr = @labels.f.towards @labels.b, @wide
    ll_trr = ll_tr.towards @labels.b, @serif
    ll_br = @labels.e.towards @labels.d, @wide

    outline.drawLine @labels.f, @labels.e
    outline.drawLine ll_tr, ll_br
    llls = outline.drawTouchingCircle @labels.e, @labels.f, @labels.a
    llrs = outline.drawTouchingCircle ll_trr, ll_tr, ll_br

    rl_tl = @labels.g.towards @labels.a, @narrow
    rl_tll = rl_tl.towards @labels.a, @serif
    rl_bl = @labels.e.towards @labels.c, @narrow

    outline.drawLine rl_tl, rl_bl
    outline.drawLine @labels.g, @labels.e
    rlls = outline.drawTouchingCircle rl_bl, rl_tl, rl_tll
    rlrs = outline.drawTouchingCircle @labels.b, @labels.g, @labels.e

    render = new FillShape sys.ctx

    render.moveTo @labels.e
    render.addArc llls, true
    render.addArc llrs, true
    render.lineTo (intersect ll_tr, ll_br, rl_tl, rl_bl)
    render.addArc rlls, true
    render.addArc rlrs, true

    render.closeAndFill()
    outline.labelPoints @labels
    return
            

wide, serif, and narrow are proportions of the square, OutlineDrawer and FillShape are classes that manage drawing the construction lines that are used for the constraints, and managing rendering the glyph respectively

As usual the code for this can be found on GitHub and a demo page can be found at github.io

---

1. Fortunately now available on Project Gutenburg
2. There is also discussion and examples of lower case letters, but not ones that would match the uppercase latin letters

Joined-up Engineering

There are many well known differences between American and British English, but it can be the less well known that make me stop and think.
Where Americans will refer to 'print(ed)' and 'cursive' handwriting, the British are much more likely to use the word 'joined-up' instead of 'cursive' ¹
In the late 90's the phrase Joined-up Government was used by the Blair administration to promote the idea that government departments should work together. How well this can work for government departments is a matter of debate, but I feel that the idea has serious applicability to software engineering.

The Analogy

If we consider the different tasks, or types of task, in a software project to be the letters, are we 'printing' and performing the tasks in isolation, or performing 'joined-up engineering' and allowing the tasks to naturally flow into and influence their neighbors?
Non-trivial projects have more than one engineer, different tasks and roles are filled by different people with different abilities and specializations — large projects have more than one team.
To me, joined-up engineering emphasizes the importance of that everyone is working on the same project, that there is a line of work or responsibility that flows cleanly through each task/engineer/role/team, rather than the hard boundaries that produce problems like: fiefdoms; impedance mismatch; feature and code ownership arguments; &c.

Stretching the Analogy

• While the general principal of joined-up writing is that the pen never leaves the page, there are well known exceptions, we "dot the i's and cross the t's" (hopefully not forgetting j's (or accents)), x is usually written by lifting the pen — knowing when not to apply a principal is important.
• Speaking for myself, I can probably print faster than I can write joined-up, but my joined up writing is (or has the potential to be) far more attractive, and with practice probably faster.
• Bureaucracies prefer print — as anyone who has filled in official paperwork knows — in the most exaggerated cases each letter must be within its own box, this is purely for the benefit of the bureaucracy.

---

1 The British politician Jonathan Aitken, while serving a prison sentence for perjury, was given the nickname "Joino" by fellow inmates for his ability(!) to use joined-up handwriting.

Tiny Basic using PEG and F#

Prompted by +Mike Begley I just used the peg parser I showed in previous blog posts to make a simple implementation of Tiny Basic

	module tinybasic
	open System
	type Expression =
	| Number of int
	| Variable of string
	| String of string
	| Binary of Expression * string * Expression
	| Unary of string * Expression
	| VarList of string list
	| ExprList of Expression list
	| PrintSeparator of string
	type Statement =
	| Command of string
	| Gosub of Expression
	| Let of string * Expression
	| Input of string list
	| Goto of Expression
	| If of Expression * Statement
	| Print of Expression list
	| Rem
	type ParseResult =
	| Line of int * Statement
	| Immediate of Statement
	| Parsed of Expression
	| Unmatched
	| TerminalSymbol of string
	| Production of ParseResult list
	| EmptyMatch
	let syntaxError s = failwithf "Syntax Error %A" s
	let parseString (s:string) _ =
	Parsed <| (Expression.String (s.[1..s.Length - 2].Replace("\"\"","\"")))
	let parseFactor s = function
	| Parsed _ as x -> x
	| Production [TerminalSymbol "("; _; x ; _; TerminalSymbol ")"] -> x
	| _ -> syntaxError s
	let parseBinary s = function
	| Production [x; EmptyMatch] -> x
	| Production [Parsed x; Production y] ->
	Parsed <| List.fold (fun l -> function | Production [_; TerminalSymbol op; _; Parsed r] -> Binary (l, op, r) | _ -> syntaxError s) x y
	| _ -> syntaxError s
	let parseUnary s = function
	| Production [EmptyMatch; _; x] -> x
	| Production [TerminalSymbol op; _; Parsed x] -> Parsed <| Unary (op, x)
	| _ -> syntaxError s
	let parseVarList s = function
	| Production [Parsed (Variable x); EmptyMatch] -> Parsed <| VarList [x]
	| Production [Parsed (Variable x); Production y] ->
	Parsed (VarList (x :: List.map (function | Production [_; TerminalSymbol ","; _; Parsed (Variable y)] -> y | _ -> syntaxError s) y))
	| _ -> syntaxError s
	let parseExprList s = function
	| Production [Parsed x; EmptyMatch; _; TerminalSymbol y] -> Parsed <| ExprList [x; PrintSeparator y]
	| Production [Parsed x; EmptyMatch; _; EmptyMatch] -> Parsed <| ExprList [x]
	| Production [Parsed x; Production y; _; z] ->
	let right = List.collect (function | Production [_; TerminalSymbol s; _; Parsed y] -> [PrintSeparator s; y] | _ -> syntaxError s) y
	let term = match z with | TerminalSymbol t -> [PrintSeparator t] | EmptyMatch -> [] | _ -> syntaxError z
	Parsed (ExprList (x :: List.append right term))
	| _ -> syntaxError s
	let parsePredicate s = function
	| Production [Parsed l; _; TerminalSymbol op; _; Parsed r] -> Parsed <| Binary (l, op, r)
	| _ -> syntaxError s
	let parseStatement s = function
	| Production [TerminalSymbol "PRINT"; _; Parsed (ExprList x)] -> Immediate <| Print x
	| Production [TerminalSymbol "IF"; _; Parsed x; _; TerminalSymbol "THEN"; _; Immediate y] -> Immediate <| If (x, y)
	| Production [TerminalSymbol "GOTO"; _; Parsed x] -> Immediate <| Goto x
	| Production [TerminalSymbol "INPUT"; _; Parsed (VarList x)] -> Immediate <| Input x
	| Production [TerminalSymbol "LET"; _; Parsed (Variable x); _; TerminalSymbol "="; _; Parsed y] -> Immediate <| Let (x, y)
	| Production [TerminalSymbol "GOSUB"; _; Parsed x] -> Immediate <| Gosub x
	| Production (TerminalSymbol "REM" :: _) -> Immediate <| Rem
	| Immediate (Command _) as x -> x
	| _ -> syntaxError s
	let parseLine s = function
	| Production [EmptyMatch; _; x; _; EmptyMatch] -> x
	| Production [Parsed (Number x); _; Immediate y; _; EmptyMatch] -> Line (x, y)
	| _ -> syntaxError s
	(*%%
	line <- number? space statement space <epsilon> { parseLine }
	statement <- print / if / goto / input / let / gosub / rem / command { parseStatement }
	print <- printkey space expr-list
	if <- ifkey space predicate space "THEN" space statement
	goto <- gotokey space expression
	input <- inputkey space var-list
	let <- letkey space var space '=' space expression
	gosub <- gosubkey space expression
	rem <- remkey <anychar>*
	command <- ({Lu} / {Ll})+ { (fun (s:string) _ -> Immediate <| Command (s.ToUpper())) }
	printkey <- [Pp] [Rr] ([Ii] [Nn] [Tt])? { (fun _ _ -> TerminalSymbol "PRINT") }
	ifkey <- [Ii] [Ff] { (fun _ _ -> TerminalSymbol "IF") }
	gotokey <- [Gg] [Oo] [Tt] [Oo] { (fun _ _ -> TerminalSymbol "GOTO") }
	inputkey <- [Ii] [Nn] ([Pp] [Uu] [Tt])? { (fun _ _ -> TerminalSymbol "INPUT") }
	letkey <- ([Ll] [Ee] [Tt])? { (fun _ _ -> TerminalSymbol "LET") }
	gosubkey <- [Gg] [Oo] [Ss] [Uu] [Bb] { (fun _ _ -> TerminalSymbol "GOSUB") }
	remkey <- ([Rr] [Ee] [Mm]) / "'" { (fun _ _ -> TerminalSymbol "REM") }
	expr-list <- (string / expression) (space [,;] space (string / expression))* space [,;]? { parseExprList }
	var-list <- var (space ',' space var)* { parseVarList }
	predicate <- expression space relop space expression { parsePredicate }
	expression <- term (space [+-] space term)* { parseBinary }
	term <- unary (space [*/] space unary)* { parseBinary }
	unary <- [+-]? space factor { parseUnary }
	factor <- var / number / ('(' space expression space ')') { parseFactor }
	var <- {Lu} / {Ll} { (fun (s:string) _ -> Parsed <| (Variable (s.ToUpperInvariant()))) }
	number <- {Nd}+ { (fun s _ -> Parsed <| Number (Int32.Parse(s))) }
	relop <- "<>" / "<=" / '<' / "><" / ">=" / '>' / '='
	string <- '\"' ((!'\"' <anychar>) / "\"\"")* '\"' { parseString }
	space <- [ \t]* { (fun _ _ -> EmptyMatch) }
	%%*)
	type Context (program:(int * Statement * string) list, variables:Map<string,Expression>, next:int, stack:int list) =
	member this.Program = program
	member this.Variables = variables
	member this.Next = next
	member this.Stack = stack
	let comparison op =
	let fn = match op with | ">" -> (>) | ">=" -> (>=) | "<>" | "><" -> (<>) | "<" -> (<) | "<=" -> (<=) | "=" -> (=) | x -> failwithf "Unexpected operator %A" x
	(fun a b -> if fn a b then -1 else 0)
	let rec evalAsNumber (context:Context) x =
	match evalExpression context x with
	| Number a -> a
	| a -> failwithf "Expecting number not %A" a
	and evalExpression (context:Context) = function
	| Number _ as x -> x
	| Variable x -> match Map.tryFind x context.Variables with | Some y -> y | None -> Number 0
	| String _ as x -> x
	| Binary (x, op, y) ->
	let left = evalAsNumber context x
	let right = evalAsNumber context y
	let fn = match op with | "+" -> (+) | "-" -> (-) | "*" -> (*) | "/" -> (/) | a -> comparison a
	Number <| fn left right
	| Unary ("+", x) -> evalExpression context x
	| Unary ("-", x) -> Number <| -evalAsNumber context x
	| PrintSeparator _ as x -> x
	| x -> failwith "Internal Error"
	let listProgram (context:Context) = for (_,_,o) in context.Program do printfn "%s" o
	let setVariable (context:Context) name value = Context(context.Program, Map.add name value context.Variables, context.Next, context.Stack)
	let setLine (context:Context) line = Context(context.Program, context.Variables, line, context.Stack)
	let setGosub (context:Context) line = Context(context.Program, context.Variables, line, (context.Next :: context.Stack))
	let gosubReturn (context:Context) =
	match context.Stack with
	| [] -> failwith "RETURN without GOSUB"
	| (head :: tail) -> Context(context.Program, context.Variables, head, tail)
	let findLine (context:Context) = List.tryFind (fun (l, _, _) -> l >= context.Next) context.Program
	let rec runProgram (context:Context) =
	if context.Next < 0 then context
	else
	match findLine context with
	| Some (n, s, _) -> evalImmediate (setLine context (n + 1)) s |> runProgram
	| None -> setLine context -1
	and evalImmediate context = function
	| Command "CLEAR" -> Context([], Map.empty, 0, [])
	| Command "LIST" ->
	listProgram context
	context
	| Command "RUN" -> runProgram <| setLine context 0
	| Command "END" -> Context(context.Program, context.Variables, -1, [])
	| Command "RETURN" -> gosubReturn context
	| Command x -> failwithf "Unknown command %A" x
	| Goto x ->
	let cp = setLine context <| evalAsNumber context x
	if context.Next < 0 then runProgram cp else cp
	| Gosub x ->
	let cp = setGosub context <| evalAsNumber context x
	if context.Next < 0 then runProgram cp else cp
	| Let (x,y) -> setVariable context x <| evalExpression context y
	| Print x ->
	let rec doPrint = function
	| [] -> printfn ""
	| [PrintSeparator ";"] -> ()
	| [PrintSeparator ","] -> printf "\t"
	| (head :: tail) ->
	match head with
	| Number n -> printf "%d" n
	| String s -> printf "%s" s
	| PrintSeparator "," -> printf "\t"
	| PrintSeparator ";" -> ()
	| _ -> failwithf "Eval error %A" head
	doPrint tail
	doPrint <| List.map (evalExpression context) x
	context
	| If (x, y) ->
	match evalExpression context x with
	| Number 0 -> context
	| Number _ -> evalImmediate context y
	| a -> failwithf "Eval error %A" a
	| Input x ->
	let rec doInput context = function
	| [] -> context
	| (head :: tail) ->
	printf "?"
	match Int32.TryParse(Console.ReadLine()) with
	| (true, i) -> doInput (setVariable context head (Number i)) tail
	| (false, _) -> failwith "Input error"
	doInput context x
	| Rem -> context
	let addLine (context:Context) l s o =
	let rec insertLine = function
	| [] -> [(l,s,o)]
	| ((currLine, _, _) as curr :: tail) ->
	if currLine = l then ((l,s,o) :: tail)
	else if currLine < l then (curr :: insertLine tail)
	else ((l,s,o) :: curr :: tail)
	Context(insertLine context.Program, context.Variables, context.Next, context.Stack)
	do
	let rec runBasic context =
	printf "?"
	let line = Console.ReadLine()
	if line.StartsWith("!") then
	match line.[1..].Split([|' '|], 2) with
	| [|"load"; file|] ->
	let lines = Seq.ofArray <| System.IO.File.ReadAllLines(file)
	let program = Seq.fold (fun c l -> match parse l with | (Line (x, y), _) -> ((x, y, l) :: c) | _ -> failwith "Error reading file") [] lines
	runBasic <| Context(List.rev program, Map.empty, 0, [])
	| [|"save"; file|] ->
	System.IO.File.WriteAllLines(file, List.map (fun (_,_,l) -> l) context.Program)
	runBasic context
	| [|"quit"; file|] | [|"exit"; file|] -> ()
	| _ -> printfn "Did not understand %A" line
	runBasic context
	else
	try
	match parse line with
	| (Immediate x, _) ->
	runBasic <| evalImmediate context x
	| (Line (x, y), _) ->
	runBasic <| addLine context x y line
	| (Unmatched, _) ->
	printfn "Syntax error"
	runBasic context
	| x -> printfn "%A" x
	runBasic context
	with
	| ex -> printfn "%s" ex.Message
	runBasic context
	printfn "Running Tiny Basic (F# edition)"
	runBasic <| Context([], Map.empty, 0, [])

view raw peg-4-tinybasic.fs hosted with ❤ by GitHub

This allows simple Tiny Basic code to run, !load and !save do the obvious things

	10 GOSUB 100
	20 GOSUB 200
	30 IF A <> 0 THEN GOTO 10
	40 PRINT "Goodbye!"
	50 END
	100 '----------------------
	101 ' read a number into A
	102 '----------------------
	110 PRINT "Enter a number";
	120 INPUT A
	130 RETURN
	200 '-----------------
	201 ' print A A^2 A^3
	202 '-----------------
	210 PRINT A, A*A, A*A*A
	220 RETURN

view raw peg-4-test.bas hosted with ❤ by GitHub

Parsing Expression Grammar - part 3

The PEG parser at the end of part 2 will parse, and call out to code when a rule is parsed, but isn't particularly easy to use, most particularly because the grammar has to be expressed as F# objects. In this post I'll extend the parser to be able to parse PEG from a text file, and to generate F# code for a parser described by that PEG.

There are only two (big) things missing from the code needed to do this, a parser for PEG - which I will write as (you guessed it) a PEG, and the code generator for the parser.

Parsing PEG

Parsing the PEG requires a complete grammar.

	hexDigit <- [0123456789abcdefABCDEF]
	escapedCharacter <- '\\' ([abfnrtv0\\"'[\]] / ('u' hexDigit hexDigit hexDigit hexDigit))
	safeCharacter <- escapedCharacter / (!["\\\n] <anychar>)
	oneofCharacter <- escapedCharacter / (![\\\]] <anychar>)
	terminalUnicode <- '{' ( "Lu" / "Ll" / "Lt" / "Lm" / "Lo" / "Mn" / "Mc" / "Me" / "Nd" / "Nl" / "No" / "Pc" / "Pd" /
	"Ps" / "Pe" / "Pi" / "Pf" / "Po" / "Sm" / "Sc" / "Sk" / "So" / "Zs" / "Zl" / "Zp" / "Cc" /
	"Cf" / "Cs" / "Co" / "Cn" ) '}'
	terminalOneOf <- '[' oneofCharacter+ ']'
	terminalCharacter <- '\'' safeCharacter '\''
	terminalWord <- '\"' safeCharacter+ '\"'
	terminal <- terminalWord / terminalCharacter / terminalOneOf / terminalUnicode / "<anychar>" / "<epsilon>"
	space <- [ \t\r\n]+
	name <- ({Lu} / {Ll} / '-') ({Lu} / {Ll} / {Nd} / [_-])*
	nonterminal <- name
	atom <- terminal / nonterminal / ('(' space? expr space? ')')
	unary <- ([!&] unary) / (atom [*+?])?
	sequence <- unary (space unary)*
	choice <- sequence (space? '/' space? sequence)*
	expr <- choice
	codechar <- (![{}\] <anychar>) / ('\\' [{}\\]) / ('{' codechar* '}')
	codeblock <- '{' codechar* '}'
	rule <- name space? "<-" space? expr space? codeblock? space? <epsilon>

view raw peg-3-pegGrammar.peg hosted with ❤ by GitHub

Parser changes

I have added a few new terminal types to the Expression type defined in part 1, these allow a grammar to specify a terminal symbol match on one of a selection of characters, to match a character (strictly a UTF-16 character) based on a Unicode category, and to match any character, These make specifying real world grammars (including that for PEG itself) very much easier.

	type Expression =
	| Terminal of string
	| TerminalOneOf of string
	| TerminalUnicode of UnicodeCategory
	| TerminalWildcard
	| NonTerminal of string
	| Epsilon
	| Sequence of Expression list
	| Choice of Expression list
	| ZeroOrMore of Expression
	| OneOrMore of Expression
	| Optional of Expression
	| And of Expression
	| Not of Expression
	| Rule of string * Expression * string

view raw peg-3-expression.fs hosted with ❤ by GitHub

Because I have added terminal types that operate on a per character basis, I've added a simple utility method that gets the next single character from the input, if any. This is this only place in the code where surrogate pairs are specifically handled.

	let currentCharacter (s:string) i =
	if i >= s.Length then None
	else if Char.IsSurrogatePair(s, i) then Some s.[i..i+1] else Some s.[i..i]

view raw peg-3-currentchar.fs hosted with ❤ by GitHub

I have extended parseExpression in the obvious way to parse the new terminal expressions.

	let parseExpression (grammar:Map<string,GrammarRule<'a>>) start (input:string) =
	let rec parse offset = function
	| Terminal x ->
	let e = offset + x.Length - 1
	if e < input.Length && input.[offset..e] = x then (TerminalSymbol x, e + 1) else (Unmatched, offset)
	| TerminalOneOf x -> match currentCharacter input offset with
	| Some c -> if x.Contains(c) then (TerminalSymbol c, offset + c.Length) else (Unmatched, offset)
	| None -> (Unmatched, offset)
	| TerminalWildcard -> match currentCharacter input offset with
	| Some c -> (TerminalSymbol c, offset + c.Length)
	| None -> (Unmatched, offset)
	| TerminalUnicode x -> match currentCharacter input offset with
	| Some c -> if Char.GetUnicodeCategory(c, 0) = x then (TerminalSymbol c, offset + c.Length) else (Unmatched, offset)
	| None -> (Unmatched, offset)
	| NonTerminal x ->
	let rule = grammar.[x]
	// .
	// .

view raw peg-3-parseExpression.fs hosted with ❤ by GitHub

Parsing PEG

I now have enough pieces to be able to create a PEG parser for PEG, this is in the file pegOfPeg.fs, an example of one of the grammar rules is...

	// unary <- ([!&] unary) / (atom [*+?])?
	let parseUnary _ = function
	| Production [TerminalSymbol "!"; Parsed x] -> Parsed <| Not x
	| Production [TerminalSymbol "&"; Parsed x] -> Parsed <| And x
	| Production [Parsed x; TerminalSymbol "*"] -> Parsed <| ZeroOrMore x
	| Production [Parsed x; TerminalSymbol "+"] -> Parsed <| OneOrMore x
	| Production [Parsed x; TerminalSymbol "?"] -> Parsed <| Optional x
	| Production [Parsed _ as x; EmptyMatch] -> x
	| x -> unexpected x
	let unaryRule = GrammarRule<Expression>(Choice [Sequence [TerminalOneOf "!&"; NonTerminal "unary"];
	Sequence [NonTerminal "atom"; Optional(TerminalOneOf "*+?")]], parseUnary)

view raw peg-3-pegOfPeg.ex.fs hosted with ❤ by GitHub

The rest of the files is much the same, with a parse method for each rule in the grammar and a corresponding F# declaration.

Code Generation

The main method for code generation is a recursive function which matches an Expression argument. For the simplest expression types, those that don't require recursively parsing one or more expressions, the code generation consists of writing code that calls out to the function that performs the parsing for that terminal type (for the terminals), matching the end of the input (for the <epsilon> rule), and calls a rule matching function (whose generation I will show below) - for NonTerminal rules. The functions ibprintf and ibprintfn are used to print an indented string to a StringBuilder.

	let rec codeGen (b:StringBuilder) i = function
	| Terminal x -> ibprintf b i """matchTerminal "%s" input offset""" <| escape x
	| TerminalOneOf x -> ibprintf b i """matchTerminalOneOf "%s" input offset""" <| escape x
	| TerminalWildcard -> ibprintf b i """matchTerminalWildcard input offset"""
	| TerminalUnicode x -> ibprintf b i """matchTerminalUnicode System.Globalization.UnicodeCategory.%s input offset""" <| string(x)
	| Epsilon -> ibprintf b i """if offset = input.Length then (EmptyMatch, offset) else (Unmatched, offset)"""
	| NonTerminal x -> ibprintf b i """matchRule%s input offset""" <| capitalIdentifier x

view raw peg-3-codegen1.fs hosted with ❤ by GitHub

To match Sequence and Choice expressions, the code generator generates a list of lambdas, each of which is recursively generated by the codeGen function, one for each sub-expression of the Sequence or Choice. This list of lambdas is then past to the utility function matchSequence or matchChoice as appropriate.

	| Sequence x | Choice x as y ->
	let fn = match y with | Sequence _ -> "Sequence" | Choice _ -> "Choice" | _ -> failwith "Internal Error"
	let processItem index item =
	ibprintfn b 0 ""
	ibprintfn b (i + 4) "(fun offset -> "
	codeGen b (i + 8) item
	ibprintf b 0 ");"
	ibprintf b i "let l = ["
	List.iteri processItem x
	ibprintf b 0 "] in match%s input offset l" fn

view raw peg-3-codegen2.fs hosted with ❤ by GitHub

For the expressions which wrap a single expression (Optional, ZeroOrMore, OneOrMore, And, and Not) a similar approach generates a lambda for the inner expression and passes it to the appropriate utility function.

	| ZeroOrMore x | OneOrMore x | Optional x | And x | Not x as y ->
	let fn = match y with | ZeroOrMore _ -> "ZeroOrMore" | OneOrMore _ -> "OneOrMore" | Optional _ -> "Optional" | And _ -> "And" | Not _ -> "Not" | _ -> failwith "Internal Error"
	ibprintfn b i "match%s input offset (fun offset -> " fn
	codeGen b (i + 8) x
	ibprintf b 0 ");"

view raw peg-3-codegen3.fs hosted with ❤ by GitHub

When matching a top-level grammar rule the code generator creates a function; there are two possible code paths, for rules where there is no code defined to be executed when the rule is matched (in which case the function simply recursively generates the code for the inner expression), and for rules where there is code to be executed on the successful match of the rule, where matching on the result of the inner expression has to be called to ensure that the code is not executed inappropriately. I make no effort to ensure that the code specified in the grammar is valid.

	| Rule (x, y, z) ->
	ibprintfn b 0 "matchRule%s (input:string) (offset:int) = " <| capitalIdentifier x
	let j = i + 4
	if z = "" then codeGen b j y else
	ibprintfn b j "let res = "
	codeGen b (j + 4) y
	ibprintfn b 0 " in"
	ibprintfn b (j + 4) "match res with"
	ibprintfn b (j + 4) "| (Unmatched, _) -> (Unmatched, offset)"
	ibprintf b (j + 4) "| (parsed, endOffset) -> (%s input.[offset..endOffset - 1] parsed, endOffset)" z
	ibprintfn b 0 ""

view raw peg-3-codegen4.fs hosted with ❤ by GitHub

The code generator for the Rule expression doesn't generate a valid function, there is no let rec prefixed; this is because the rule matching methods have to be mutually recursive, so an outer function is used to call codeGen for rules - it is that function which is told whether this is the first rule or not.

	let codeGenRule b i first = function
	| Rule _ as x ->
	ibprintf b i "%s " <| if first then "let rec" else "and"
	codeGen b i x
	| x -> failwithf "Cannot generate code for %A" x

view raw peg-3-codeGenRule.fs hosted with ❤ by GitHub

The rest of the code generator is found in peg.fs and consists of bolier plate implementations of the functions used by the generated code and utility functions that make the rest of the code generation easier.

Left recursion

A PEG parser cannot work with a grammar that contains left recursion. Left recursion occurs when a non-terminal symbol in the left position in an expression recursively (either directly or indirectly) refers to the same rule. The left position is the first element in a Sequence (this is a simplification!), any element in a Choice, and for the expressions that have a single sub-expression, that sub-expression is always in the left-position. It can be difficult to determine which elements in a sequence are in the left position because a Non-Terminal that successfully matches with zero-width (for example an Optional or ZeroOrMore expression)

a <- a b     The simplest form of left recursion

a <- b c
b <- a / c   Indirect left recursion

a <- b c
b <- d a     Left recursive because d can match without consuming input
d <- e?      even though a is not in the obvious left position

The following code detects simple forms of left recursion, but doesn't find the third example above.

	let checkForLeftRecursion (rules:Map<string,Expression>) =
	let rec leftRules = function
	| Terminal _ | TerminalOneOf _ | TerminalUnicode _ | TerminalWildcard | Epsilon -> []
	| NonTerminal x -> [x]
	| ZeroOrMore x | OneOrMore x | Optional x | Not x | And x -> leftRules x
	| Choice x ->
	List.concat <| List.map leftRules x
	| Sequence x ->
	let rec processList = function
	| [] -> []
	| (head :: tail) ->
	match head with
	| Optional _ | Not _ | And _ | ZeroOrMore _ | OneOrMore _ -> List.append (leftRules head) (processList tail)
	| x -> leftRules head
	processList x
	| Rule _ -> failwith "Internal error"
	let rec checkRule name prior =
	if List.exists ((=) name) prior then
	failwithf "Left recursion calling %s" <| List.reduce (fun a b -> (b + " -> " + a)) (name :: prior)
	match Map.tryFind name rules with
	| None -> failwithf "Unknown rule %s" name
	| Some x ->
	let leftchoices = leftRules x
	let sp = (name :: prior)
	for rule in leftchoices do checkRule rule sp done
	try
	Map.iter (fun k _ -> checkRule k []) rules
	with
	| ex -> eprintfn "Grammar error: %s" ex.Message
	failwith "Invalid Grammar"

view raw peg-3-checkForLeftRecursion.fs hosted with ❤ by GitHub

Putting it all together

The code in Program.fs puts this together into a program that takes an input file and writes an output, taking a grammar description, prefix and suffix from the input file. The format of the input file is as follows:

prefix written verbatim to the output file
(*%%
grammar rules
%%*)
suffix written verbatim to the output file

The section separators in the input file ((*%% and %%*)) are chosen to be similar to yacc and to allow the input file to be read as valid F#, which makes writing the prefix and suffix easier! The example on github implements a basic calculator program.

If the -x argument is passed to the parser generator, it will attempt to compile and execute the output file, this is done using the FSharpCodeProvider class from the F# power pack, Vladimir Ivanovskiy has a great article about Embedded Scripting using F#.

	use compiler = new FSharpCodeProvider()
	let parameters = CompilerParameters()
	parameters.GenerateExecutable <- true
	parameters.GenerateInMemory <- true
	let result = compiler.CompileAssemblyFromSource(parameters, parser)
	if result.Errors.Count > 0 then
	for error in result.Errors do eprintfn "%O" error done
	else
	for output in result.Output do printfn "%O" output done
	printfn "Executing..."
	try
	result.CompiledAssembly.EntryPoint.Invoke(null, null) |> ignore
	with
	| ex -> eprintfn "Error executing generated code: %s" ex.Message

view raw peg-3-compile.fs hosted with ❤ by GitHub

As usual, all the code for this is on github.

Parsing Expression Grammar - part 2

At the end of part 1 I had a parser that will parse a PEG, but isn't that useful because its output is simply a recursive data structure of the matched elements.

The next step is to add the ability to process each matching production rule. I do this by associating a function with each rule, the function takes two arguments - the matching string and the parsed elements - and returns a parse result. The parse result type is extended to allow passing an arbitrary type as a parse result...

	type ParseResult<'a> =
	| Parsed of 'a
	| TerminalSymbol of string
	| Production of ParseResult<'a> list
	| EmptyMatch
	| Unmatched

view raw peg-2-parseResult.fs hosted with ❤ by GitHub

This adds the Parsed of 'a type to the discriminated union.

Because each grammar element now requires three pieces of information (name, expression, function) I define a record type to make handling this easier. The function declaration of parseExpression changes as expected.

	type GrammarRule<'a>(prod:Expression, func:(string -> ParseResult<'a> -> ParseResult<'a>)) =
	member this.Prod = prod
	member this.Func = func
	let parseExpression (grammar:Map<string,GrammarRule<'a>>) start (input:string) =

view raw peg-2-grammarrule.fs hosted with ❤ by GitHub

The changes needed to parseExpression are small...

	| NonTerminal x ->
	let rule = grammar.[x]
	match parse offset rule.Prod with
	| (Unmatched, _) as y -> y
	| (parsed, endOffset) -> (rule.Func input.[offset..endOffset - 1] parsed, endOffset)
	// ...
	parse 0 <| NonTerminal start

view raw peg-2-parseExpression.fs hosted with ❤ by GitHub

The original pattern match for NonTerminal simply recursively called parse with the definition for the NonTerminal name, now the same recursive call is made but, if the result is a successful match, the function associated with the match is called and the result of that function is passed as the result of the match.

Grammar example - 1

Taking the same grammar I used in part 1, I now need to add a function to each rule.

In this example, I am evaluating the expression as it is being parsed, this is the simplest approach, later on I will show a two stage approach where the expression is converted to an AST that can be evaluated later.

	// bool <- "true" / "false"
	let boolRule = GrammarRule<bool>(Choice [Terminal "true"; Terminal "false"], (fun s _ -> Parsed (s = "true")))
	// paren <- "(" expr ")"
	let parseParen _ = function
	| Production [TerminalSymbol "("; x; TerminalSymbol ")"] -> x
	| x -> unexpected x
	let parenRule = GrammarRule<bool>(Sequence [Terminal "("; NonTerminal "expr"; Terminal ")"], parseParen)
	// not <- "!" atom
	let parseNot _ = function
	| Production [TerminalSymbol "!"; Parsed x] -> Parsed <| not x
	| x -> unexpected x
	let notRule = GrammarRule<bool>(Sequence [Terminal "!"; NonTerminal "atom"], parseNot)
	// atom <- bool / paren / not
	let atomRule = GrammarRule<bool>(Choice [NonTerminal "bool"; NonTerminal "paren"; NonTerminal "not"], (fun _ x -> x))
	// and <- atom ("&" and)?
	// or <- and ("|" or)?
	let parseBin _ = function
	| Production [x; EmptyMatch] -> x
	| Production [Parsed x; Production [TerminalSymbol "&"; Parsed y]] -> Parsed (x && y)
	| Production [Parsed x; Production [TerminalSymbol "|"; Parsed y]] -> Parsed (x || y)
	| x -> unexpected x
	let andRule = GrammarRule<bool>(Sequence [NonTerminal "atom"; Optional (Sequence [Terminal "&"; NonTerminal "and"])], parseBin)
	let orRule = GrammarRule<bool>(Sequence [NonTerminal "and"; Optional (Sequence [Terminal "|"; NonTerminal "or"])], parseBin)
	// expr <- or
	let exprRule = GrammarRule<bool>(NonTerminal "or", (fun _ x -> x))
	// start <- expr <epsilon>
	let parseStart _ = function
	| Production [x; EmptyMatch] -> x
	| x -> unexpected x
	let startRule = GrammarRule<bool>(Sequence [NonTerminal "expr"; Epsilon], parseStart)

view raw peg-2-grammar.fs hosted with ❤ by GitHub

Hopefully each of these is self explanatory, the same function can be used to parse both & and | because they have equivalent structure; the first pattern in parseBin is taken when the Optional second element of the Sequence is not matched.

	let g = Map.ofList [("bool", boolRule); ("paren", parenRule); ("not", notRule); ("atom", atomRule);
	("and", andRule); ("or", orRule); ("expr", exprRule); ("start", startRule)]

view raw peg-2-grammarMap.fs hosted with ❤ by GitHub

This code can now evaluate simple boolean expressions...

> parseExpression g "start" "true&false";;
val it : ParseResult<bool> * int = (Parsed false, 10)
> parseExpression g "start" "true|true&false";;
val it : ParseResult<bool> * int = (Parsed true, 15)
> parseExpression g "start" "(true|true)&false";;
val it : ParseResult<bool> * int = (Parsed false, 17)

Grammar example - 2

In this example the same grammar (with some minor changes, such as allowing whitespace) demonstrates parsing into an AST (the BooleanExpr type) which is then evaluated in a second stage.

	type BooleanExpr =
	| Atom of bool
	| Binary of BooleanExpr * string * BooleanExpr
	| Not of BooleanExpr
	let rec evalBool = function
	| Atom x -> x
	| Binary (left, "&", right) -> if evalBool left then evalBool right else false
	| Binary (left, "|", right) -> if evalBool left then true else evalBool right
	| Binary (_, x, _) -> failwith <| "Unexpected binary operator: " + x
	| Not x -> not <| evalBool x
	let boolGrammar =
	// bool <- "true" / "false"
	let boolRule = GrammarRule<BooleanExpr>(Choice [Terminal "true"; Terminal "false"], (fun s _ -> Parsed (Atom (s = "true"))))
	// space <- " "*
	let spaceRule = GrammarRule<BooleanExpr>(ZeroOrMore (Terminal " "), (fun _ _ -> EmptyMatch))
	// paren <- "(" space expr space ")"
	let boolParen _ = function
	| Production [TerminalSymbol "("; EmptyMatch; x; EmptyMatch; TerminalSymbol ")"] -> x
	| x -> unexpected x
	let parenRule = GrammarRule<BooleanExpr>(Sequence [Terminal "("; NonTerminal "space"; NonTerminal "expr"; NonTerminal "space"; Terminal ")"], boolParen)
	// not <- "!" atom
	let boolNot _ = function
	| Production [TerminalSymbol "!"; Parsed x] -> Parsed (Not x)
	| x -> unexpected x
	let notRule = GrammarRule<BooleanExpr>(Sequence [Terminal "!"; NonTerminal "atom"], boolNot)
	// atom <- "bool" / "paren" / "not"
	let atomRule = GrammarRule<BooleanExpr>(Choice [NonTerminal "bool"; NonTerminal "paren"; NonTerminal "not"], (fun _ x -> x))
	// or <- atom space ("|" space or)?
	// and <- or space ("&" space and)?
	let boolBinary _ = function
	| Production [x; EmptyMatch; EmptyMatch] -> x
	| Production [Parsed x; EmptyMatch; Production [TerminalSymbol op; EmptyMatch; Parsed y]] -> Parsed (Binary (x, op, y))
	| x -> unexpected x
	let orRule = GrammarRule<BooleanExpr>(Sequence [NonTerminal "atom"; NonTerminal "space"; Optional (Sequence [Terminal "|"; NonTerminal "space"; NonTerminal "or"])], boolBinary)
	let andRule = GrammarRule<BooleanExpr>(Sequence [NonTerminal "or"; NonTerminal "space"; Optional (Sequence [Terminal "&"; NonTerminal "space"; NonTerminal "and"])], boolBinary)
	// expr <- and
	let exprRule = GrammarRule<BooleanExpr>(NonTerminal "and", (fun _ x -> x))
	// start <- space expr space <epsilon>
	let boolStart _ = function
	| Production [EmptyMatch; x; EmptyMatch; EmptyMatch] -> x
	| x -> unexpected x
	let startRule = GrammarRule<BooleanExpr>(Sequence [NonTerminal "space"; NonTerminal "expr"; NonTerminal "space"; Epsilon], boolStart)
	Map.ofList [("bool", boolRule); ("space", spaceRule); ("paren", parenRule); ("not", notRule);
	("atom", atomRule); ("or", orRule); ("and", andRule); ("expr", exprRule); ("start", startRule)]
	let parseAndEvalBool expr =
	match parseExpression boolGrammar "start" expr with
	| (Parsed b, _) -> printfn "%s = %A" expr (evalBool b)
	| x -> unexpected x

view raw peg-2-boolGrammar.fs hosted with ❤ by GitHub

The code for this artice is on github.

In part 3 I make things a little more practical, expressing the grammar as literal objects is very clumsy - I build a parser that parses textual PEG expressions...

Parsing Expression Grammar - part 1

I'm not a great language and grammar theoretician, so I'm not going to go into great detail about what a Parsing Expression Grammar (PEG) is, but here are a few observations.

• PEGs don't require a tokenizing stage - this can be a mixed blessing, but does mean that the grammar can be entirely expressed in one specification
• Tools like yacc and bison create parsers from LALR grammars - this is a relatively complicated procedure and requires that the grammar either be very carefully constructed to contain no ambiguity, or to be annotated such that the parser always knows how to resolve that ambiguity
• Grammars expressed as PEGs don't really have this problem (although you can't have left recursion - which I'll get to eventually)

I'm using F# for the code in this series of posts, I'm not a completely fluent F# programmer so there may be some clumsy code in places, but it is a very succinct and clean language for this type of work.

A very simple introduction to PEG

A very minimalist implementation of a PEG only requires a few elements, I'll add some more later, both for completeness and convenience; a PEG expression is comprised of:

• Terminal symbol - which is commonly represented as text in quotation marks - "foo" would be a terminal symbol
• A NonTerminal symbol - a word or identifier not in quotations mars - e.g. foo
• Empty - matches the end of the input - represented with an epsilon 
• A Sequence - a list of expressions, each of which must be matched in order - represented as a space separated list
• A Choice - a list of expressions, tested in order, the first match is chosen - represented as a list of expressions separated by /
• Zero or More - an expression that can occur any number of times, including zero - represented as a * suffix
• One or More - an expression that can occur any number of times, but must occur at least once - represented as a + suffix
• Optional - an expression that may or may-not match - represented as a ? suffix
• And - an expression that must match but that isn't captured by the matching process - represented as a & prefix
• Not - an expression that must not match and isn't captured by the matching process - represented as a ! prefix

First Implementation

While grammars are usually stored as text files, I'm going to start with the in memory representation of the PEG expressions.

	type Expression =
	| Terminal of string
	| NonTerminal of string
	| Epsilon
	| Sequence of Expression list
	| Choice of Expression list
	| ZeroOrMore of Expression
	| OneOrMore of Expression
	| Optional of Expression
	| And of Expression
	| Not of Expression

view raw peg-1-expression.fs hosted with ❤ by GitHub

This is a straight-forward translation of the description of the elements into an F# discriminated union type, before I dive into how to process this, I'll show some code that will print a PEG expression in a human readable form.

	let printPeg expr =
	let rec pegToString = function
	| Terminal x -> "\"" + x + "\""
	| NonTerminal x -> x
	| Epsilon -> "<epsilon>"
	| Sequence x -> List.map pegToString >> List.reduce (fun a b -> a + " " + b) <| x
	| Choice x -> List.map pegToString >> List.reduce (fun a b -> a + " / " + b) <| x
	| ZeroOrMore x -> pegToString x + "*"
	| OneOrMore x -> pegToString x + "+"
	| Optional x -> pegToString x + "?"
	| And x -> "&" + pegToString x
	| Not x -> "!" + pegToString x

view raw peg-1-printPeg-1.fs hosted with ❤ by GitHub

There is nothing particularly complex about this, the Sequence and Choice patterns use the forward function combination operator >> to pipeline converting the list of expressions into a list of strings (map), and then to join the elements using the appropriate separator (reduce).

To check that this works as expected I'll try a few expressions in F# interactive.

> printPeg <| Terminal "foo";;
"foo"
val it : unit = ()
> printPeg <| NonTerminal "foo";;
foo
val it : unit = ()
> printPeg <| Sequence [NonTerminal "atom"; Optional (Sequence [Terminal "*"; NonTerminal "product"])];;
atom "*" product?
val it : unit = ()

This doesn't quite work how I want it to, in the last expression it isn't clear what is optional, so I need to make printPeg a touch more complex...

	let rec pegToString expr =
	let pegToStringParen = function
	| Terminal _ | NonTerminal _ | Epsilon as x -> pegToString x
	| x -> "(" + pegToString x + ")"
	match expr with
	| Terminal x -> "\"" + x + "\""
	| NonTerminal x -> x
	| Epsilon -> "<epsilon>"
	| Sequence x -> List.map pegToStringParen >> List.reduce (fun a b -> a + " " + b) <| x
	| Choice x -> List.map pegToStringParen >> List.reduce (fun a b -> a + " / " + b) <| x
	| ZeroOrMore x -> pegToStringParen x + "*"
	| OneOrMore x -> pegToStringParen x + "+"
	| Optional x -> pegToStringParen x + "?"
	| And x -> "&" + pegToStringParen x
	| Not x -> "!" + pegToStringParen x
	let printPeg expr =
	printfn "%s" <| pegToString expr

view raw peg-1-printPeg-2.fs hosted with ❤ by GitHub

This now perhaps errs on the the cautious side, but adds parenthesis where they are needed...

> printPeg <| Sequence [NonTerminal "atom"; Optional (Sequence [Terminal "*"; NonTerminal "product"])];;
atom (("*" product)?)
val it : unit = ()

When text is parsed against a grammar, there needs to be a internal representation of the parsed data, in part 2 when I'll add functions to grammar rules, this representation is the input those functions.

	type ParseResult =
	| TerminalSymbol of string
	| Production of ParseResult list
	| EmptyMatch
	| Unmatched

view raw peg-1-parseResult-1.fs hosted with ❤ by GitHub

• TerminalSymbol - hopefully self explanatory
• Production - represents a Sequence, ZeroOrMore, or OneOrMore
• EmptyMatch - Used for non-capturing successful matches ZeroOrMore (with zero matches), Optional (not present), And, Not
• Unmatched - No match found

Taking the parse function in parts.

First this the atomic expressions, these are all pretty straightforward.

	let parseExpression (grammar:Map<string,Expression>) start (input:string) =
	let rec parse offset = function
	| Terminal x ->
	let e = offset + x.Length - 1
	if e < input.Length && input.[offset..e] = x then (TerminalSymbol x, e + 1) else (Unmatched, offset)
	| NonTerminal x -> parse offset grammar.[x]
	| Epsilon -> if offset = input.Length then (EmptyMatch, offset) else (Unmatched, offset)

view raw peg-1-parse-pt1.fs hosted with ❤ by GitHub

Moving on the Sequence and Choice

	| Sequence x ->
	let rec parseList lst off =
	seq {
	if List.isEmpty lst then ()
	else
	match parse off <| List.head lst with
	| (Unmatched, _) as y -> yield y
	| (y, z) -> yield (y, z)
	yield! parseList (List.tail lst) z
	}
	let s = List.ofSeq <| parseList x offset
	if List.exists (function | (Unmatched, _) -> true | _ -> false) s then (Unmatched, offset)
	else (Production <| List.map fst s, snd <| List.maxBy snd s)
	| Choice x ->
	let rec parseList lst =
	if List.isEmpty lst then (Unmatched, offset)
	else
	match parse offset <| List.head lst with
	| (Unmatched, _) -> parseList <| List.tail lst
	| y -> y
	parseList x

view raw peg-1-parse-pt2.fs hosted with ❤ by GitHub

The pattern for Sequence creates an F# seq over the list of sub-expressions for the sequence, when an expression doesn't match the sequence is terminated with an Unmatched parse result; that is used as a signal to mark that the Sequence as a whole didn't match; otherwise the results from the sub-expressions are packaged into a Production parse result.

The pattern for Choice enumerates over the sub-expressions until it finds the first one that matches; that result is returned.

The rest...

	| ZeroOrMore x ->
	let rec parseList off =
	seq {
	match parse off x with
	| (Unmatched, _) -> ()
	| (y, z) -> yield (y, z)
	yield! parseList z
	}
	let s = List.ofSeq <| parseList offset
	if List.isEmpty s then (EmptyMatch, offset)
	else (Production <| List.map fst s, snd <| List.maxBy snd s)
	| OneOrMore x ->
	let rec parseList off =
	seq {
	match parse off x with
	| (Unmatched, _) -> ()
	| (y, z) -> yield (y, z)
	yield! parseList z
	}
	let s = List.ofSeq <| parseList offset
	if List.isEmpty s then (Unmatched, offset)
	else (Production <| List.map fst s, snd <| List.maxBy snd s)
	| Optional x ->
	match parse offset x with
	| (Unmatched, _) -> (EmptyMatch, offset)
	| y -> y
	| And x ->
	match parse offset x with
	| (Unmatched, _) -> (Unmatched, offset)
	| _ -> (EmptyMatch, offset)
	| Not x ->
	match parse offset x with
	| (Unmatched, _) -> (EmptyMatch, offset)
	| _ -> (Unmatched, offset)
	parse 0 grammar.[start]

view raw peg-1-parse-pt3.fs hosted with ❤ by GitHub

ZeroOrMore and OneOrMore are almost the same, DRY suggests that I should break out the common code for these patterns; both collect a sequence of contiguous matches for the sub-expression, they differ only in how they handle the empty collection.

Optional, And, and Not can all be pulled onto one line (depending on how wide your monitor is...) they simply filter the response from the recursive parsing.

parseExpression is then rounded out with a call to the inner function to start the recursive parsing in the context of the grammar and input string.

Trying it out

First here's a simple grammar for boolean arithmetic.

	let g = Map.ofList [("bool", Choice [Terminal "true"; Terminal "false"]);
	("paren", Sequence [Terminal "("; NonTerminal "expr"; Terminal ")"]);
	("not", Sequence [Terminal "!"; NonTerminal "expr"]);
	("atom", Choice [NonTerminal "bool"; NonTerminal "paren"; NonTerminal "not"]);
	("and", Sequence [NonTerminal "atom"; Optional (Sequence [Terminal "&"; NonTerminal "and"])]);
	("or", Sequence [NonTerminal "and"; Optional (Sequence [Terminal "|"; NonTerminal "or"])]);
	("expr", NonTerminal "or");
	("start", Sequence [NonTerminal "expr"; Epsilon])]

view raw peg-1-grammar.fs hosted with ❤ by GitHub

The printPeg function still works...

> Map.fold (fun _ k v -> printfn "%s -> %s" k <| pegToString v) () g;;
and -> atom (("&" and)?)
atom -> bool / paren / not
bool -> "true" / "false"
expr -> or
not -> "!" expr
or -> and (("|" or)?)
paren -> "(" expr ")"
start -> expr <epsilon>
val it : unit = ()

Map has sorted its elements, but the printed representations are as expected.

> parseExpression g "start" "true&true|false";;
val it : ParseResult * int =
  (Production
     [Production
        [Production
           [TerminalSymbol "true";
            Production
              [TerminalSymbol "&";
               Production [TerminalSymbol "true"; EmptyMatch]]];
         Production
           [TerminalSymbol "|";
            Production
              [Production [TerminalSymbol "false"; EmptyMatch]; EmptyMatch]]];
      EmptyMatch], 15)
> parseExpression g "start" "true|true&false";;
val it : ParseResult * int =
  (Production
     [Production
        [Production [TerminalSymbol "true"; EmptyMatch];
         Production
           [TerminalSymbol "|";
            Production
              [Production
                 [TerminalSymbol "true";
                  Production
                    [TerminalSymbol "&";
                     Production [TerminalSymbol "false"; EmptyMatch]]];
               EmptyMatch]]]; EmptyMatch], 15)
> 

This shows how the precedence of the operators is defined explicitly in the grammar, rather than by annotating tokens or rules.

In part 2, I'll turn this into something usable.

The code for this article is on github.