DEV Community: Nikhil Thomas

Learning Tarjan's Algorithm - solving Leetcode to learn graph theory

Nikhil Thomas — Sat, 16 May 2020 17:56:00 +0000

Intro

After reading source code for bundlers, linters, compilers, and other projects I've been convinced that everything is a graph. Well, not everything but enough. So I began digging into practice algorithm questions on Leetcode, AlgoExpert and other websites. I'm pretty comfortable at coding up BFS and DFS when it's obviously a matter of "search for this element" but knowing when to model something as a graph when it's a little more vague is a challenge.

One of my personal goals is being able to code up most Leetcode hard questions in under 20 minutes. My hope is that practicing repeatedly will give me enough exposure to graph and tree traversal algorithms, array sorting and searching, etc so when I do write new projects at work or contribute to open source, patterrn recognition will kick in. Most Leetcode hard questions are fairly well written, and if not at least have a well authored solution. However, no matter what, Leetcode 1192 stumped me. It's flagged as hard, rated fairly highly on frequency of interviews seen, yet there's no canonical solution and many of the user answers aren't too clear.

I spent some time doing my own reading outside of Leetcode. I didn't find many of the Youtube videos to be helpful. However, in a bit of luck I stumbled onto these lecture notes from an NYU course on data structures. It happens to be the final lecture for the entire course, which is somewhat satisfying to know that at least my graph theory knowledge only has holes at the later stages of education.

Description

First off, I highly recommend reading the problem once or twice. Then, take a best effort at solving it!

Now let's dig in.

There are n servers numbered from 0 to n-1 connected by undirected server-to-server connections forming a network where connections[i] = [a, b] represents a connection between servers a and b. Any server can reach any other server directly or indirectly through the network.

A critical connection is a connection that, if removed, will make some server unable to reach some other server.

Return all critical connections in the network in any order.

Our input parameters are n, the number of nodes in our graph, and an edge list. We know the graph is undirected (that is, node A points to node B and node B points to node A).

We are looking for critical connections, or the edges that will effectively break our graph into two smaller graphs. That is

before

    1 <----> 2 <----> 3
    ^        ^
    |        |
    v        v
    4 <----> 5

If we broke the connection between 2 and 3, and then our graph breaks into two parts and nodes 1, 2, 4 and 5 are unreachable from 3.

after

    1 <----> 2      3
    ^        ^
    |        |
    v        v
    4 <----> 5

The key insight here is that we're looking for the bridge between strongly connected components. Luckily this is a solved problem, and Tarjan's algorithm will come to the rescue.

Let's come up with a quick definition of a strongly connected component that works for us. A strongly connected component can be thought of as a graph in which no one edge is the weak link in the graph. Or, all edges have at least one backup to keep the graph tied together if it disappears.

If we take a set of nodes and number them in the order we visit them (like a timestamp, or just a monotonically increasing id), we can end up building an array of IDs. Let's call that the dfsNumber array, is for any node i the order we visited it in a depth first search.

Additionally, we want to know how far "backwards" into a graph a node can reach. If we know nothing about a node, the "oldest" seen node that node N can see is itself. Once we start to look at neighbor nodes, we can assert that the oldest node a neighbor can reach is the oldest node any of its neighbors can reach (ignoring the direct parent we came from). We can hold oldestReachable in an array, where oldestReachable[i] indicates the oldest timestamp reachable from node i

Let's visualize this. I'll use letters for node names so dfsNumbers are clear.

    A  <--->  B
    ^         ^
    |         |
    v         v
    D  <--->  C

If we start at node named A, we label it with a dfsNumber of 1, and we also assert that right now, the oldestReachable for A is also 1. Now we look at its neighbors and travel ONLY if they have no dfsNumber. Once we label it's neighbors, we look to see how far back thhe neighbor can reach.

So we'll pick B, give it a dfsNumber and oldestReachable of two. Then we dfs into C, labeled with 3, then D as 4. Remember this is DFS, so we have a call stack. So

1) Visit and label A
2) visit and label B
3) visit and label D
4) visit and label D. Then we visit A.
5) A has a label so we do nothing. What's the oldest D can reach? Currently, it's 4. But we look. Can a neighbor reach older? Yes! A can reach older (itself)! So we declare that, oldestReachable for D is equal to oldestReachable for A, or oldestReachable[D] = 1

now we unwind the call stack.

What's the oldest C can reach? Well, since we said D can reach to A and C can reach D, C can reach A or oldestReachable[C] = 1

As we unwind the stack, we keep assigning all oldestReachable values to 1.

Now when would this be false? What's an example of a graph where some components do not have neighbors that can reach back into the graph? Another visualization and example.

    A  <--->  B
    ^      /  ^
    |    /    |
    v  /      v
    D         C

A points to B and D. B points to A, D and C. C points to B. D points to B and D. Let's again begin our traversal, starting at A

1) visit and label A. dfsNumber of 1, oldestReachable is itself of 1. Pick a neighbor - randomly select D
2) Visit and label D. dfsNumber of 2, oldestReachable is itself of 2. Pick a neighbor. We just came from A, so we have to go to B.
3) Visit and label B. dfsNumber of 3, oldestReachable is itself of 3. Pick a neighbor. We just came from D, so we have to go to C.
4) Visit and label C. dfsNumber of 4, oldestReachable is itself of 4. Pick a neighbor. We just came from B, so we have nowhere to go. Unwind the call stack and go back to B
5) B's oldestReachable is the lowest of its own oldestReachable and the oldestReachable of the neighbor we just procesesed (D). D = 4, B = 3. So D cannot reach further back into the graph on its own. Therefore we know that, if we remove the edge between B and D, D becomes part of a new graph.

    A  <--->  B
    ^      /
    |    /
    v  /
    D         C  (ALONE)

Pseudocode

Let's try and write this in pseudocode

  numberOfNodes = n
  dfsNumber = new Array, numberOfNodes in length
  oldestReachable = new Array, numberOfNodes in length
  timestamp = 0

  dfs(node, parent, graph)
    timestamp++
    dfsNumber[node] = timestamp
    oldestReachable[node] = timestamp

    for neighbor of graph[node]
      if neighbor is parent, continue
      if !dfsNumber(neighbor) dfs(neighbor, node, graph) // unlabeled neighbor

      // check if neighbor can reach deeper. If yes, reset our oldestReachable

      oldestReachable[node] = min of oldestReachable[node], oldestReachable[neighbor]

      // check if this neighbor's oldest reachable isn't as old as where we are now

      if oldestReachable[neighbor] > dfsNumber[node]
        collect [node, neighbor]


  dfs(idx, null, graph)

Solution

Now, Leetcode gives us an edge list but Tarjan's algorithm requires an adjacency list. So the first thing we do is process our data. Otherwise we follow our steps.

var criticalConnections = function(n, connections) {
  const adjacency = {}
  for (let i = 0; i < n; i++) {
    adjacency[i] = []
  }

  for (let [node1, node2] of connections) {
    adjacency[node1].push(node2)
    adjacency[node2].push(node1)
  }

  const dfsNumber = new Array(n).fill(0)
  // this is what we called oldestReachable
  // the lowest number reachable by dfs from a node
  const dfsLow = new Array(n).fill(0)
  const criticalEdges = []
  let timestamp = 0

  function tarjan(node, parent, adjacency, edges) {
    timestamp++
    dfsNumber[node] = timestamp
    dfsLow[node] = timestamp

    for (let neighbor of adjacency[node]) {
      if (neighbor === parent) continue
      if (!dfsNumber[neighbor]) tarjan(neighbor, node, adjacency, edges)

      // resetting oldestReachable if neighbor can cycle back
      dfsLow[node] = Math.min(dfsLow[node], dfsLow[neighbor])

      // if neighbor cannot reach back to me or oldest, we have a critical edge
      if (dfsLow[neighbor] > dfsNumber[node]) edges.push([node, neighbor])
    }
  }

  tarjan(0, null, adjacency, criticalEdges)

  return criticalEdges
}

And lo and behold, our solution works.

Let me know what you thought. If these kinds of articles are useful, and I should write more of them I'll happily do so. I'm most easily reached on Twitter (@nikhilthomas90).

What Functional Programming Taught Me About Object Oriented Programming

Nikhil Thomas — Tue, 24 Dec 2019 06:05:42 +0000

Introduction

My background

My introduction to programming professionally came in the era of everybody-choosing-Rails. After a brief stint at a coding bootcamp, I was able to write some code but my understanding of "object oriented" was simply rails g model model_name. I lacked an appreciation for how much I could delegate to various object classes and assumed that I had to be constantly modifying state with imperative workflows. Code looked very much like

user = User.find(id)
user.school = School.find(school_id)
user.is_enrolled? = true
user.classes.each { |class| class.cancel }
user.classes = []
user.save

As I began to explore more interactive web applications, that pseudo-OO style of highly imperative code with primitives became harder to maintain.

for(let event of eventList) {
  for (let org of event.organizations) {
    if (currentUser.organizations.includes(org.id) {
      // some DOM operation
    } else if (some other clause){
      if (this other thing is true) {
        // some other DOM operation
      }
    }
  }
}

A sufficiently large code base with lots of people working, with different features developed at the same time can get unwieldy. A coworker at the time was an enthusiast of Clojure(script) and we began using RamdaJS as a functional utility library and ImmutableJS for our data structures. Immediately I felt more in control and thought to myself "Wow, object orientation is terrible! This makes way more sense to just operate on data!"

Of course, as time went on I began to get too clever and focused on functional-at-all-costs.

compose(
  length,
  curry(someNativeFnForLists),
  map(someDataTransformation),
  filter(somePredicate),
)

This might be straightforward in a blurb (kinda...) but again, imagine doing a code review in Github after hours of feature development under tight deadlines. Does this convey intent to the reader? I was so concerned with using reduce and map because I thought Lisp-inspired FP was what mattered that I threw away the real goal, immutability and clarity of code.

I've been bouncing back and forth between the styles, slowly narrowing down on some shared set of values that allow me to write useful, easily-changed, quick-to-understand code. It turns out that there exists a family of languages that provided me the tools and framework needed to think about problem-solving.

Inspirations

The ML-family of languages ("meta-language", not "machine learning") is a functional school of thought with expressive types. Languages like OCaml, Haskell and Elm (and to some extent - Rust and Swift) are built with the expectations of fast compilers with many customized types, moduluar code with separation of boundaries, and immutability of data.

The first place this made sense was watching Yaron Minksy's talk Effective ML. Watching him take a blob of data representing a connection, seeing some "option" data in his types and quickly tearing them out into concrete types with known data made a ton of sense.

The second place I began to see this, but from an more object-oriented perspective, was Gary Bernhardt's Boundaries talk. In it, he describes pushing his mutation to the boundaries of his code and having as much of a functional core with an imperative shell to communicate with outside systems.

All of this, combined with coding in various languages and making many mistakes led me to start thinking about how to write code in a way that both OO and FP styles are trying to solve. But to get to that, I need to know what I care about.

Coding Values

TDD or test after? Static types or dynamic? Compiled or interpreted languages? Mutable or immutable? These are binary questions people ask (and are asked in interviews) where I think the answer fails to get at the crux of the matter. TDD isn't about tests. It's about confidence that your code solves the problem you want. Static types don't exist because some programmers hate the flexibility of duck-typing. Rather, it's about a formalization to the compiler of your assumptions and states of the world.

Since I write mostly enterprise software, I do care about performance and metrics than can be quantified in time. But my biggest wins seem to come from more qualitative metrics. Was a feature easy to implement? Are two functions very tightly coupled - that is, does changing function A break the tests of function B? Am I confident that adding a new function call doesn't break a call site elsewhere? I know I'm working in a garbage-collected environment, and there's a pretty good chance that the biggest performance hit to the user comes from the amount of work the essential complexity that is enforced by my problem domain.

My values are confidence in my code, clarity of intent to another programmer, comfort in changing the code for future features and much more. Knowing this, I've been able to take what I need from FP to write better OO code when needed.

What I've taken from FP

Types are cheap

This is heavily inspired from writing OCaml code. In OCaml, it would be very straightforward to write some code like

module Math = struct
  type shape =  
    | Circle of float
        | Rect of float * float
        | Triangle of float * float

  let get_area x : shape = match x with 
    | Circle radius -> radius ** 2.0 *. Math.pi
    | Rect (w, h) -> w *. h
        | Triangle (base, h) -> 0.5 *. base *. h
end

and let the compiler help make sure that every time I have a shape type, I'm handling the correct variants. In the old Lisp-inspired JS days, I might have written entire functions and workflows so that my triangle state never ended up entangled with my rectangle. But the ability to create types inside a module to logically separate my cases.

This cheapness of classes should be embraced. I'm probably not persisting Triangles in my database, but it's a perfectly useful way to hold onto my data inside the Math module so I should just have these classes where I need them. I wish Ruby had private classes scoped to modules, but the essential idea remains the same.

module Math

  def calculate_area(shape)
    shape.get_area
  end

  class Triangle
    def get_area
      base * height * 0.5
    end
  end

  class Rectangle
    def get_area
      width * height
    end
  end

  class Circle
    def get_area
      radius ** 2 * 3.14
    end
  end
end

More Types Yields More Refactorings

Specifically, the Replace Conditional With Polymorphism and Replace Primitive With Object / Primitive Obsession refactorings from Martin Fowler are very much an object-oriented translation of the ML type tagging. Perhaps you're writing an OCaml function that takes a name and an email address (both strings) to validate a user's information.

val validate: string -> string -> bool
let validate email name = (* somethingHappens *)

You could very easily accidentally swap the others around in a call site by accident and the compiler wouldn't be able to help you with that - after all, strings are strings. But what if you had small types to tag the data?

type email = Email of string
type name = Name of string

val validate : email -> name -> bool
let validate (Email emailAddress) (Name userName) = (* something happens *)

Similarly, you can use this idea to just make small structs with tests in object-oriented code. Yes, you lack the compiler guarantees in a dynamic language but you can convey intent better to your co-authors of code who are then less likely to make that mistake of swapping parameters.

Create new instances as much as you want

Just because a class instance can modify its internal state doesn't mean it has to. It's just as easy to calculate the new state and create a new instance of your object if you create classes as structs over data.

User = Struct.new(:name, :email) do
  def update_email(new_email)
    User.new(name, new_email)
  end
end

user = User.new("test", "test@email.com")
puts user
puts user.update_email("updated@email.com")

Encapsulate your data with a set of methods that describes behavior, create new instances to your heart's content, and push mutation as far away from core business logic so you know exactly where it happens. You might have a UserUpdater that takes a user and persists in the database, or a PageRenderer that handles drawing pixels (effectively React's concept of declarative programming), but your core objects can just take messages and pass around new objects.

Takeaways

I think my biggest takeaway from thinking about all this and everything I learned is that object oriented code and functional programming styled-code aren't these huge dichotomies. You don't need to pick a side. There are no winners or losers here. Everyone is trying to express intent and wrangle complexity over software as best as they can. Find the amount of expressiveness that lets people easily update their code. Classes can serve as ML-style types for the reader - humans aren't compilers, but if they know all shapes must have an area, that's a lot better than passing around primitives with no context. Immutability can help make sure that you know exactly what your data is representing at a given line. Ultimately, don't optimize for "the best OO style" or "the best FP style" because you read something on Twitter or Hacker News. Optimize for the person who's going to update your code after you're gone.

You Can Invent Javascript Scopes

Nikhil Thomas — Tue, 12 Nov 2019 02:26:01 +0000

This small post is a heavily simplified way to think about Javascript scopes. Since we're not writing a compiler or interpreter, we don't have a particularly nice AST to work with. However, for learning purpose I think this helps. For further education, read Crafting Interpreters, Writing a Compiler in Go, or the excellent posts by Dmitry Soshnikov.

Repl.it found here
Github found here

Javascript closures were tremendously tricky for me to grasp. I had a coworker who tried to explain them as "a function that CLOSES OVER a value" which wasn't particularly illuminating, but I eventually began to get a feel for how scope worked. However, it wasn't until I wrote a compiler in Go that I began to better understand what was happening under the hood.

The common question of "write a function that only lets a function run once" is a great example.

const once = fn => {
  let canRun = true

  return (...args) => {
    if (canRun) {
      canRun = false
      return fn.apply(null, ...args)
    }
  }
}

let fn = once(() => console.log('hello'));
fn()
fn()

This just works. Why? I'll let you read Dmitry's post on scope chain for a very detailed review of Javascript scope, but let's perhaps make it simple for ourselves.

A program has a global environment. An environment is simple a map of keys to values, where keys are variables and values are their assignments. An environment can also have an outer environment, that is, a function has an internal environment that allows it to have a locally scoped variable assignment. Environments are first-class objects that can have an infinitely long outer-chain.

In code, that might look something like

class Environment {
  constructor(environment, store) {
    this.outer = environment;
    this.store = {};
  }

  get(name) {`
    if (this.store[name]) return this.store[name];
    if (this.outer) return this.outer.get(name);
    return null;
  }

  set(name, value) {
    return this.store[name] = value;
  }
}

A store is the environment's inner mapping of keys to values. The outer value refers to it's parent, for when we enter a function scope. Let's create a couple of helpers along the way.

const GLOBAL_ENV = new Environment();

function assign(env, name, value) {
  env.set(name, value);
}

function read(env, name) {
  env.get(name);
}

This will just allow us to test out our code in a nice, declarative fashion. Note that Environment.prototype.get looks up the outer chain by calling itself on the next environment up. As long as there are parents, we can keep looking until we get nothing. We could model this as a stack (pushing and popping as we enter and leave scope) but this is a little easier.

Let's model our functions as a class. We want to be able to capture the function we plan on executing, the environment at the time of it's creation, and for ease let's also capture an array of strings representing the parameters the function needs. We'll later use that list to look up our parameter values at runtime. It'll look something like


class FunctionObject {
  constructor(env, fn, parameters = []) {
    this.fn = fn;
    this.parameters = parameters;
    // capture state of environment at creation time
    this.env = env;
  }

  eval(env, paramValues) {
    // assign an outer environment
    // make sure to keep captured store values
    let newEnv = new Environment(env, this.env.store);
    for (let i = 0; i < paramValues.length; i++) {
      // for every parameter we pass in to eval, assign the value to environment store
      let param = this.parameters[i];
      let val = paramValues[i];
      newEnv.set(param, val);
    }

    // apply args from params to fn
    // all our functions need an environment to read from, so we push that to the front of the list
    // you can imagine some compiler step dynamically reading from environment
    let allParamValues = this.parameters.map(param => newEnv.get(param));
    let argsToCall = [newEnv].concat(allParamValues);
    return this.fn.apply(newEnv, argsToCall);
  }
}

Our FunctionObject can be created and later evaluated with parameter values. When we eval a function, we capture the environment at time of execution, then, make sure the closest lookup is the function's environment captured at creation time. You can then call something like

const env = GLOBAL_ENV
assign(env, 'x', 5);
const logX = (env) => console.log(env.get('x'));
const fnObj = new FunctionObject(env, logX, ['x']);
fnObj.eval(env, []); // logs 5

assign(env, 'x', 10)
fnObj.eval(env, []); // logs 10

You'll see that logX takes an environment and reads from it. That's actually the role of the interpreter or compiler, to replace all variable reads with the lookup. Since we're not writing an interpreter, you can imagine that function is actually console.log(x) that's later compiled into what we're writing.

What's really shown here is that we're able to NOT send an explicit value of x in the parameter list to a function and it can be read from an environment.

Our program then is a series of scope entries, where we can effectively open and close scopes by creating functions to capture and throw away environments.

const GLOBAL_ENV = new Environment();

const functionScope = (env) => {
  // create a local env, where it's outer scope is inherited
  let localEnv = new Environment(env)
  assign(localEnv, 'x', 1);
  assign(localEnv, 'y', 2);
  assign(localEnv, 'z', 100);
  let sumFn = (env, x, y) => console.log('OUTER ', env.get('x') + env.get('y') + env.get('z'));
  let sum = new FunctionObject(localEnv, sumFn, ['x', 'y', 'z']);

  sum.eval(localEnv, [5, 6]) // expect 5 + 6 + 100 = 111
  assign(localEnv, 'z', 200);
  sum.eval(localEnv, [5, 6]) // expect 5 + 6 + 200 = 211

  innerScope(localEnv);
  // note that in innerScope, we overrode the value of 'z' but that's thrown away when we get back here
  sum.eval(localEnv, [100, 100]) // expect 100 + 100 + 200 = 400
}

const innerScope = env => {
  let localEnv = new Environment(env);
  assign(localEnv, 'z', 300); //
  let sumFn = (env, x, y) => console.log('INNER ', env.get('x') + env.get('y') + env.get('z'));
  let sum = new FunctionObject(localEnv, sumFn, ['x', 'y', 'z']);
  sum.eval(localEnv, [5, 6]) // expect 5 + 6 + 300 = 311
}

functionScope(GLOBAL_ENV)

This is a quick and dirty way to think about function scope! When we enter a new scope, we capture all the outside environment values and use those, and when we leave that scope we no longer consider that our environment.

This was a fun learning exercise, and certainly only touches a VERY high level of how the Javascript engine translates a variable lookup, but hopefully the model of "scopes are just environments that are thrown away when a function ends, and environments are just maps of variables to values" helps further understand why

const once = fn => {
  let canRun = true

  return (...args) => {
    if (canRun) {
      canRun = false
      return fn.apply(null, ...args)
    }
  }
}

let fn = once(() => console.log('hello'));
fn()
fn()

actually works. Because the once function captures a scope that the inner function has access to and can modify.

Writing an Interpreter in OCaml

Nikhil Thomas — Mon, 19 Aug 2019 16:25:51 +0000

Code is on my Github

Background

I've decided to take another stab at this interpreter. I'll be using Thorsten Ball's book Writing an Interpreter in Go as my primary source, with extra reading material from Bob Nystrom's Crafting Interpreters. I find that Thorsten's book gets me productive faster, while Bob's material is deeper and helps clarify and illuminate what I don't understand.

Thorsten's book defines a language called Monkey, that's similar in syntax to Javascript. Curly braces, integer math, not whitespace sensitive, recursion, the whole nine yards.

For this project I'll be using the OCaml language. OCaml sits at an intersection of academia and large production-scale software. It's used at Jane Street, Docker, Bloomberg, Facebook and other companies. I plan on redoing this project in Haskell eventually - I missed some syntax and conventions from Haskell in writing this chapter. I find inline function composition and application is more readable with Haskell's dot notation and $ application than pipelines.

-- Haskell
next_char . read_char $ lexer

(* OCaml *)
lexer |> read_char |> next_char

Requirements

Dune 1.11.x
opam 2.0.3
OCaml 4.07.1
Alcotest 0.8.5 (testing framework)
Fmt 0.8.8 (pretty printer for testing)

Use opam to set up OCaml and install those dependencies. I chose a new version of Dune, and I went with Alcotest as it seemed relatively popular on the OCaml discord. It's also quite readable and pleasant to configure.

Project structure

Take a look at this commit for some files you can copy

ROOT
  - dune-project
  - monkey.intall
  - monkey.opam
  - src/
    - dune
  - test/
    - dune

The dune files will let you link and build your code and run the tests. We'll update these as we move along, but for now this will get you started.

Defining our first tokens

The first step for Thorsten's interpreter is defining a subset of our tokens. In lexical analysis, a token is a simple data structure that represents a small piece of syntax in our programming language. A token could be a SEMICOLON, a PLUS_SIGN, an IDENTIFIER("x"), an INTEGER(5), or some other representation.

We're going to define our tokens in src/token.ml. Create that file and let's add some code. We're going to open a module and add basic tokens.

module Token = struct
  type token_type =
    | ILLEGAL
    | EOF
    (* Identifiers and literals *)
    | IDENT of string
    | INT of int
    (* Operators *)
    | ASSIGN
    | PLUS

    (* -- Delimiters *)
    | COMMA
    | SEMICOLON
    | LPAREN
    | RPAREN
    | LBRACE
    | RBRACE
    (* -- Keywords *)
    | FUNCTION
    | LET
end

We're also going to add a token_to_string function so we can print out some tokens for our tests, as well as keep our compiler happy when it inevitably barks at us for unused code.

let token_to_string = function
  | ILLEGAL -> "ILLEGAL"
  | EOF -> "EOF"
  | IDENT a -> "IDENT " ^ a
  | INT a -> "INT " ^ string_of_int a
  | ASSIGN -> "ASSIGN"
  | PLUS -> "PLUS"
  | COMMA -> "COMMA"
  | SEMICOLON -> "SEMICOLON"
  | LPAREN -> "LPAREN"
  | RPAREN -> "RPAREN"
  | LBRACE -> "LBRACE"
  | RBRACE -> "RBRACE"
  | FUNCTION -> "FUNCTION"
  | LET -> "LET"

Unlike Thorsten's Go implementation, we don't need to keep a list of constants. Rather, we can use OCaml's algebraic data types to represent tokens. In fact, OCaml is commonly used in compilers and similar dev tools for exactly this reason.

Thorsten then moves on to creating some tests, in order to build his NextChar function. We're going to similar add tests.

We'll need to set up a small module export. Create src/monkey.ml and add the following code.

module Token = Token
module Lexer = Lexer

Create a file test/test.ml and let's add a bit of boilerplate.


open Monkey
include Lexer
include Token

let token_testable = Alcotest.testable Token.pretty_print (=)

let test_lexer_delimiters () =
  Alcotest.(check (list token_testable))
    "same token types" [
        Token.ASSIGN
      ; Token.PLUS
      ; Token.LPAREN
      ; Token.RPAREN
      ; Token.LBRACE
      ; Token.RBRACE
      ; Token.COMMA
      ; Token.SEMICOLON
      ; Token.EOF
      ]
      (Lexer.generate_tokens "=+(){},;")

let () =
  Alcotest.run "Lexer"
    [
      ( "list-delimiters",
        [ Alcotest.test_case "first case" `Slow test_lexer_delimiters ] );
    ]

See that Token.pretty_print function? We'll need to define a way to return a formatting string representing our Token. Let's go back into src/token.ml

let pretty_print ppf tok = Fmt.pf ppf "Token %s" (token_to_string tok)

We can look at Alcotest's source code to dig into what this code does. Effectively, for any inferred type a it takes a function that formats a type a and an equality checking function that takes two a and returns a boolean. You can look at the implementations of int32 or string to get a hint of how that works. Our token_testable is a module that works on Token.token_type, our defined set of token tags. If we were to run dune runtest we'd get an error because we haven't yet implemented our lexer. So let's do that.

Setting up the Lexer

Let's create src/lexer.ml.

(* lexer *)

module Lexer = struct
  include Token

  type lexer = {
    input : string;
    position : int;
    read_position : int;
    ch : char;
  }

  let null_byte = '\x00'

  let new_lexer input_string =
    {
      input = input_string;
      position = 0;
      read_position = 0;
      ch = null_byte;
    }
end

I chose to use a null_byte instead of an OCaml option type because in my opinion, an Option represents a potential gap whereas we know that we won't have gaps in our source code. We'll simply be reading the string until we run out of string. The end of our source code isn't undefined, but a known value.

We need to define our read_char function. In a lexer, reading a character is simply incrementing our pointer in our lexer and looking at the next character in the input string.

let read_char lexer =
  let read_to_end = lexer.read_position >= String.length(lexer.input) in
  let new_ch = if read_to_end then null_byte else String.get lexer.input lexer.read_position
  in {lexer with position = lexer.read_position; read_position = lexer.read_position + 1; ch = new_ch}

OCaml is immutable by default, so we can't just adjust our lexer. Or rather, we can, but why do that when we can avoid that mutable state. We look to see if we're at the end of the string. If we are, the character is a null, else we get the next character in the string and update our lexer. In order to initialize our lexer, we can use our read_char. We'll update new_lexer to look like


let new_lexer input_string =
  let lexer = {
    input = input_string;
    position = 0;
    read_position = 0;
    ch = null_byte;
  } in
  read_char lexer

Awesome! Our test code is still calling Lexer.generate_tokens so we'll need to continue working on this.

let next_char lexer = match lexer.ch with
  | '=' -> (read_char lexer, Token.ASSIGN)
  | ';' -> (read_char lexer, Token.SEMICOLON)
  | '(' -> (read_char lexer, Token.LPAREN)
  | ')' -> (read_char lexer, Token.RPAREN)
  | ',' -> (read_char lexer, Token.COMMA)
  | '+' -> (read_char lexer, Token.PLUS)
  | '{' -> (read_char lexer, Token.LBRACE)
  | '}' -> (read_char lexer, Token.RBRACE)
  | '\x00' -> (lexer, Token.EOF)
  | _ -> failwith "unmatched character"

let generate_tokens input_string =
  let lexer = new_lexer input_string in
  let rec gen lxr tokens =
    match next_char lxr with
    | (_, Token.EOF) -> List.rev_append tokens [Token.EOF]
    | (l, tok) -> gen l (tok :: tokens)
  in gen lexer []

This code matches on our known inputs and returns a tuple of an updated lexer and the last read token. This tuple allows us to collect tokens and continue to call next_char until it ends in our generate_tokens function.

generate_tokens is defining a recursive function that calls next_char on a lexer. For any token, it'll add the token to a list of seen tokens and call gen again on the new lexer. Once it finds an EOF token, it will rev_append the collected tokens to the EOF.

Side note: rev_append reverses the first list and concatenates it to the second. Because we're using the OCaml cons operator in the non-EOF case, we're actually constructing a list in reverse order so we need to flip it at the end. The reason for this is that cons is constant time where append is linear time proportional to the first list (the operation has to traverse the entire list before adding the elements of the second list). So it's easier to reverse at the end (linear time once) instead of appending (linear time for every token).

If we run dune runtest we get passing tests!

Up next

The next chapter will take care of adding tokens for real source code.

Writing a Tictactoe game in Haskell

Nikhil Thomas — Mon, 12 Aug 2019 20:30:47 +0000

Code can be found here

While I struggle with some misunderstandings of the OCaml module system, I decided to put my interpreter on temporary hold to try some Haskell. It's a language that's been on my radar and been a goal to learn. A combination of Haskell's terse notation ( it turns out sum . take 10 $ (*) <$> [2,4,6] <*> [1,2,3,4,5] is a completely legitimate, if daunting line of code ) combined with the new terminology (cue monad tutorial) caused some delay. But after deciding to commit, and OCaml's slightly more friendly entry to FP, I felt capable of getting my hands dirty. I felt particularly inspired after seeing code written for Github's Semantic project. At some point, I'd like to work on some meaty Haskell productive code and there's no place to start like starting.

After reading a lot of Learn You A Haskell For Great Good and watching some Youtube videos, I felt reasonably comfortable in being able to write a small Tictactoe CLI game. I went with Stack as my build tool of choice.

Like OCaml, Haskell's type system encourages domain modeling early. I decided to make my board a list of 9 elements, where each element could be either an X, an O, or empty. Since Haskell doesn't really have a null type, I decided to create both a Move as well as a Cell

import System.Environment
import Data.List

data Move = X | O
data Cell = Occupied Move | Empty

We're taking System.Environment because we'll need some IO behavior, and Data.List for some future functions.

I could have made Cell a Maybe type, but chose a more descriptive way to express a cell. This way, I can keep track of the move to play as well as see what was in the cell. I also needed a way to render this board out. Since I'm using custom types, I needed to create instances of the Show typeclass.

instance Show Move where
  show X = "X"
  show O = "O"

instance Show Cell where
  show (Occupied X)     = "X"
  show (Occupied O)    = "O"
  show Empty            = " "

I'm semi-positive I could have used deriving (Show) on my Move type but that'll be for a later refactor. Today's primary goal was just writing code. My next plan was to get some board-rendering code up. I needed a function that simply took my board, my [Cell] and output something pretty.

renderRow :: [Cell] -> String
renderRow row = intercalate " | " $ fmap show row

dividingLine :: String
dividingLine = "----------"

renderBoard :: [Cell] -> IO ()
renderBoard board = do
  putStrLn $ renderRow firstRow
  putStrLn dividingLine
  putStrLn $ renderRow secondRow
  putStrLn dividingLine
  putStrLn $ renderRow thirdRow
  where firstRow  = take 3 board
        secondRow = drop 3 . take 6 $ board
        thirdRow  = drop 6 board

renderRow takes a list of cells and returns the readable version joined by pipes. renderBoard just some some list-slicing to render no more than 3 rows of 3 elements. Since I'm writing to console, I'll need to return an IO (), the IO monad. Without getting too in the weeds, I/O is considered to be a side-effect and therefore Haskell forces you to wrap it in a monad.

If I were to call renderBoard with a list of empty elements [Empty, Empty, Empty, Empty, Empty, Empty, Empty, Empty, Empty] I would get a very pretty

  |   |
----------
  |   |
----------
  |   |

My next goal was some idea of assignment. I needed to be able to take a Move and a [Cell] and return an updated board. There are a couple of rules to this

1) The selected cell must be within bounds.
2) The selected cell must be free.

Given this, I decided to simply create a map of input strings to List indices. Is it pretty? Nope. But it works fine for this case.

getBoardIndex :: String -> Maybe Int
getBoardIndex "A1" = Just 0
getBoardIndex "A2" = Just 1
getBoardIndex "A3" = Just 2
getBoardIndex "B1" = Just 3
getBoardIndex "B2" = Just 4
getBoardIndex "B3" = Just 5
getBoardIndex "C1" = Just 6
getBoardIndex "C2" = Just 7
getBoardIndex "C3" = Just 8
getBoardIndex _    = Nothing

Pattern matching in Haskell is a little more terse than OCaml, in that I don't need a match statement. I simply create functions for every possiblity, similar to Elixir's matching. You'll see also I'm returning a Maybe Int - I chose this because not just do I care if a board index is real, but also if it's free. Two if statements, so I can use monadic binding, or the >>= operator. For reference:

  (>>=)            :: m a -> (a -> m b) -> m b

What this says is "Give me a monad of some a, and give me a function that turns some a into a monad of b and I'll return a monad of b. If I have a Maybe Int from getBoardIndex and my function for "is that cell free to assign" takes an Int and returns a Maybe then I can use this binding.

data CellTransform = Success [Cell] | Fail String [Cell]


verifyIsFree ::  [Cell] -> Int -> Maybe Int
verifyIsFree board ix = if board !! ix == Empty then Just ix else Nothing

assignCell :: String -> Move -> [Cell] -> CellTransform
assignCell location move board =
  case getBoardIndex location >>= verifyIsFree board of
    Nothing -> Fail "Invalid move" board
    Just i -> Success ((take i board) ++ [Occupied move] ++ (drop (i+1) board))

You'll see this new CellTransform type. I added a new type just to carry along error messages and an unmodified board if the board is taken. So my verifyIsFree takes a board and index, and if the board is free at that element returns the index in a Maybe, else Nothing. Since I'm doing some equality checks of a custom data type, I'll need to make sure that Cell is also an instance of the Eq typeclass

instance Eq Cell where
  Occupied X == Occupied X = True
  Occupied O == Occupied O = True
  Empty == Empty           = True
  _ == _                   = False

This just sets my equality operator for all possible states of a Cell.

Lastly, my actual game. I need my game to

1) Ask for input
2) Try to assign the cell
3a) If the cell is invalid, tell the user and let them pick again
3b) If the cell is valid, check for a winner
4a) If there's a winner, alert them and end the game
4b) If there's no winner, hand over to the next player

Let's get this coded out

playRound :: Move  -> [Cell] -> IO ()
playRound move board = do
  putStrLn $ (show move) ++ " 's turn."
  putStrLn $ "Pick a cell from A1 to C3."
  renderBoard board
  putStr "\nInput: "
  cell <- getLine
  case assignCell cell move board of
    Fail err board -> do
      putStrLn err
      playRound move board
    Success newBoard -> do
      if isThereAWinner move newBoard then do
        putStrLn $ ("Winner! " ++ (show move) ++ " has won!")
        renderBoard newBoard
        return ()
      else playRound (nextMove move) newBoard

Since we're using I/O again, we need to return an IO Monad. That also gives us the do notation benefits of some slightly more imperative-reading code.

You'll see some fake functions - isThereAWinner and nextMove move. We can code these out.

nextMove :: Move -> Move
nextMove X = O
nextMove O = X

isThereAWinner :: Move -> [Cell] -> Bool
isThereAWinner move board =
  or [
    -- check top row
    board !! 0 == (Occupied move) && board !! 1 == (Occupied move) && board !! 2 == (Occupied move),
    -- check middle row
    board !! 3 == (Occupied move) && board !! 4 == (Occupied move) && board !! 5 == (Occupied move),
    -- check bottom row
    board !! 6 == (Occupied move) && board !! 7 == (Occupied move) && board !! 8 == (Occupied move),
    -- check left column
    board !! 0 == (Occupied move) && board !! 3 == (Occupied move) && board !! 6 == (Occupied move),
    -- check middle column
    board !! 1 == (Occupied move) && board !! 4 == (Occupied move) && board !! 7 == (Occupied move),
    -- check right column
    board !! 2 == (Occupied move) && board !! 5 == (Occupied move) && board !! 8 == (Occupied move),
    -- check top left -> bottom right
    board !! 0 == (Occupied move) && board !! 4 == (Occupied move) && board !! 8 == (Occupied move),
    -- check bottom left -> top right
    board !! 6 == (Occupied move) && board !! 4 == (Occupied move) && board !! 2 == (Occupied move)
  ]

This is my least-favorite function here. It's readable with comments, but definitely isn't pleasant. I can't imagine changing this into a 5x5 tic-tac-toe board or something. But once we have this, we can create a main function.

main :: IO ()
main = do
  putStrLn $ "The game is beginning."
  let newBoard = replicate 9 Empty
  playRound X newBoard

And we can build our tictactoe.hs with stack ghc tictactoe.hs and run ./tictactoe to play!

This was a fun experiment. I tried to avoid having to dig too into monadic operators, the State monad, or advanced Haskell techniques. My primary focus was to just type code and try to get comfortable with the syntax. The compiler is pretty helpful, but not as explicit as Elm's compiler. Since my career goals are to get a job writing backend ML-family code (Scala, OCaml, Haskell, etc) I'll keep on practicing. I'd love any project ideas. I might try to write a Lisp interpreter for a bigger, meatier project.

Crafting Interpreters in OCaml - Finishing the Lexer

Nikhil Thomas — Wed, 22 May 2019 20:32:41 +0000

This builds on my last post.

To follow along the source material, check out the Scanning chapter of Crafting Interpreters

Moving on to section 4.5.2 of the book, we have multi-character operators. Cool! Specifically, we have the !=, ==, <= and >= operators. Bob defines a match method that takes some expected character and checks to see if the current character is some character. If we're at the end, it's not. If the current character isn't the expected character, it's false. Else, we advance and return true. Okay that seems straightforward.

Let's define a match function. Remember that we don't have any global variables, so we're going to have to pass in context as well as the character. Since we want to conditionally mutate current, it makes sense that our function takes and returns a scanner_context object. We also want to maintain that boolean return, so let's return a tuple.

We also need our match function to look at the character in the next position, so we'll need a helper function.

In our scanner.mli file we can define the following:

val next_char: scanner_context -> char option

val match_character: char -> scanner_context -> bool * scanner_context

This defines a function that takes a character and a context and returns a 2-tuple of boolean and context types.

Now we can write some code

let next_char context =
  try Some (String.get context.source (context.current)) with Invalid_argument _ -> None

let match_character expected_char context = if (is_at_end context) then (false, context) else
  match next_char context with
    | Some c when c = expected_char -> (true, advance context)
    | _ -> (false, context)

You may note that next_char and current_char look really similar. I don't really have a good solution for that but that's okay for now.

Now we can add some new cases to our match statement. We're going to have to write a lot of cases that look something like

let x = match match_character '=' advanced_context with
  | (true, ctx) -> add_non_literal_token BANG_EQUAL ctx
  | (false, ctx) -> add_non_literal_token BANG ctx

But for all four above two-character operators. Since I'm finally being lazy, let's write a helper. Our new function needs to take an expected character to match, a token for the true case, a token for the false case, and a context. It will return a new context with the token added. That signature will look like

val add_conditional_non_literal_token: char -> token_type -> token_type -> scanner_context -> scanner_context

Neat. Now we can write that function

let add_conditional_non_literal_token expected_char token_if_true token_if_false context =
    match (match_character expected_char context) with
    | (true, new_context) -> add_non_literal_token token_if_true new_context
    | (false, new_context) -> add_non_literal_token token_if_false new_context

And our scan_token function now has the following new clauses:

let scan_token context =
  let advanced_context = advance context in
  match (current_char advanced_context) with
  | Some '(' -> add_non_literal_token LEFT_PAREN advanced_context
  | Some ')' -> add_non_literal_token RIGHT_PAREN advanced_context
  | Some '{' -> add_non_literal_token LEFT_BRACE advanced_context
  | Some '}' -> add_non_literal_token RIGHT_BRACE advanced_context
  | Some ',' -> add_non_literal_token COMMA advanced_context
  | Some '.' -> add_non_literal_token DOT advanced_context
  | Some '-' -> add_non_literal_token MINUS advanced_context
  | Some '+' -> add_non_literal_token PLUS advanced_context
  | Some ';' -> add_non_literal_token SEMICOLON advanced_context
  | Some '*' -> add_non_literal_token STAR advanced_context
  | Some '!' -> add_conditional_non_literal_token '=' BANG_EQUAL BANG advanced_context
  | Some '=' -> add_conditional_non_literal_token '=' EQUAL_EQUAL EQUAL advanced_context
  | Some '>' -> add_conditional_non_literal_token '=' GREATER_EQUAL GREATER advanced_context
  | Some '<' -> add_conditional_non_literal_token '=' LESS_EQUAL LESS advanced_context
  | _ -> failwith "Disallowed character"

So far we're doing great! Section 4.6 adds some more lexeme handling. Specifically, comments. Let's describe in words what Bob's code does.

If we see a slash, check to see if the next character is also a slash. If it is, just more forward until we either see a newline or reach the end of the file. If the next character ISN'T a slash, then just add a slash token. In our world we don't have multiline comments (whew).

So if we look a little ahead, we also have this peek function that, if we're at the end, returns a null character, else the character at the current position. We can use another char option here since we don't need nulls in this magical ML world.

It turns out we already wrote this function! next_char does the exact same thing. So we'll just use that. If you want, you can alias it as let peek = next_char but I won't.

We can use our match_character helper here to create another helper function. We want a function that either adds a slash token, or just moves on. Let's call that function add_conditional_slash for now. It'll take context and return context.

val add_conditional_slash: scanner_context -> scanner_context

let add_conditional_slash context =
    let rec consume_line context =
      match (not (next_char context = Some '\n')), not (is_at_end context)) with
      | (true, true) -> consume_line (advance context)
      | _ -> context
    in
    if match_character '/' context then consume_line context else add_non_literal_token SLASH context

Let's explain this code:

We nest a function to consume the entire line that says "if the next character isn't a newline AND we're not at the end of the file, then move forward a character and check again. Once either we see a newline or end of file, return the context object.

Then we simply say if the next character is a slash, consume the line. Else, add a slash token. Maybe later we'll pull out this nested function but for now I think it's okay, we have no other use cases for it.

Right - so we have some default cases that Bob lists. Let's translate those by either returning context, or in the case of a newline, increment the line in our context.

let scan_token context =
    let advanced_context = advance context in
    match (current_char advanced_context) with
    | Some '(' -> add_non_literal_token LEFT_PAREN advanced_context
    | Some ')' -> add_non_literal_token RIGHT_PAREN advanced_context
    | Some '{' -> add_non_literal_token LEFT_BRACE advanced_context
    | Some '}' -> add_non_literal_token RIGHT_BRACE advanced_context
    | Some ',' -> add_non_literal_token COMMA advanced_context
    | Some '.' -> add_non_literal_token DOT advanced_context
    | Some '-' -> add_non_literal_token MINUS advanced_context
    | Some '+' -> add_non_literal_token PLUS advanced_context
    | Some ';' -> add_non_literal_token SEMICOLON advanced_context
    | Some '*' -> add_non_literal_token STAR advanced_context
    | Some '!' -> add_conditional_non_literal_token '=' BANG_EQUAL BANG advanced_context
    | Some '=' -> add_conditional_non_literal_token '=' EQUAL_EQUAL EQUAL advanced_context
    | Some '>' -> add_conditional_non_literal_token '=' GREATER_EQUAL GREATER advanced_context
    | Some '<' -> add_conditional_non_literal_token '=' LESS_EQUAL LESS advanced_context
    | Some ' ' -> advanced_context
    | Some '\r' -> advanced_context
    | Some '\t' -> advanced_context
    | Some '\n' -> {advanced_context with line = advanced_context.line + 1}
    | _ -> failwith "Disallowed character"

Not so bad! This is looking more and more readable. How rad is this? Let's handle literals and then write some tests.

Bob defers all string handling to a function called string. In words, it does the following.

As long as the next character isn't a quote, and as long as we're not at the end just consume. If we see a newline, increment line and keep going. If we see the end of the file along the way, throw an error. Once we see the closing quote, advance one more, then grab the string and add a String token. Okay! Let's make our own function. We'll call it add_string_literal which will take and output a scanner_context.

There's some conditonal line incrementing logic that I'm going to make it's own function just for ease as well.

val increment_line_if_newline: scanner_context -> scanner_context

val add_string_literal: scanner_context -> scanner_context

 let increment_line_if_newline context =
    match next_char context with
    | Some '\n' -> {context with line = context.line+1}
    | _ -> context

  let rec add_string_literal context =
     if( not ( next_char context = Some('"')) && (not (is_at_end context)) ) then
      context |> increment_line_if_newline |> advance |> add_string_literal
    else if (is_at_end context) then failwith "Unterminated string" else
    let str = (String.sub context.source (context.start + 1) (context.current - 1)) in
    add_literal_token STRING (Some (STRING_LITERAL str)) context

It's a bit gnarly and imperative. I'd like to find a way to pattern match out. BUT now we can add the following to our scan_tokens

| Some '"' -> add_string_literal advanced_context

Starting to get exciting now. Let's also handle number literals in section 4.6.2. The rules of numbers are simple - if there is a . character, it must have 1 or more digits on both sides. So let's try and implement this.

We need a function is_digit that takes a char option and returns true or false, and then a add_number_literal function that takes and returns a scanner_context. We'll also create a peek_next along the way that takes a scanner_context and returns char option.

To make things easy, we should write a function that simply captures digits. Let's call it capture_digits. It'll just abstract out the Java code of while (isDigit(peek())) advance();. We can also write a function to defer to above with capture_decimal

In our interface:

val is_digit: char option -> bool

val capture_digits: scanner_context -> scanner_context

val capture_decimal: scanner_context -> scanner_context

val peek_next: scanner_context -> char option

val add_number_literal: scanner_context -> scanner_context

And back in scanner.ml

let peek_next context =
    try Some (String.get context.source (context.current + 1)) with Invalid_argument _ -> None

  let is_digit character = match character with
    | Some c when c >= '0' && c <= '9' -> true
    | _ -> false

  let rec capture_digits context =
    if is_digit (next_char context) then context |> advance |> capture_digits else context

  let capture_decimal context = match (next_char context) with
    | Some '.' when (is_digit peek_next context) -> context |> advance |> capture_digits
    | _ -> context

  let add_number_literal context =
    let new_context = context |> capture_digits |> capture_decimal in
    let stringified_number = (String.sub new_context.source new_context.start (new_context.current - new_context.start)
    let parsed_number = int_of_string stringified_number in
    add_literal_token NUMBER NUMBER_LITERAL(stringified_number) new_context

Then just add in scan_tokens the following clause

| digit when (is_digit digit) -> add_number_literal advanced_context

Spicy. If you go ahead and dune runtest you should get some compiler errors about unused characters but no syntax or interface errors. Woohoo!

Let's finish up identifiers real quick. Once again, skimming ahead in Bob's chapter we see the claim if isAlpha or in English, "if the next lexeme begins with a letter or underscore, capture everything that's alphanumeric after and assume it's an identifier.

Our version of is_alpha will take a char option and return boolean. So will is_alpha_numeric. Our add_identifier_literal will need to take a scanner context and return one. Let's create a new literal_type

type literal_type = STRING_LITERAL of string | NUMBER_LITERAL of float | IDENTIFIER_LITERAL of string

This new type will just wrap our identifiers that users create. If a user defines a top levek function, it's an IDENTIFIER_LITERAL. If it's a usual keyword like AND, it's just an IDENTIFIER.

To our interface to define implementations.

 val is_alpha: char option -> bool

val is_alpha_numeric: char option -> bool

val add_identifier_literal: scanner_context -> scanner_context

And our implementation

let is_alpha character = match character with
  | Some c when c >= 'a' && c <='z' -> true
  | Some c when c >= 'A' && c <='Z' -> true
  | Some c when c = '_' -> true
  | _ -> false

  let is_alpha_numeric character = (is_alpha character) || (is_digit character)

  let rec add_identifier_literal context =
    if (is_alpha_numeric (next_char context)) then context |> advance |> add_identifier_literal
    else
    let substring = (String.sub context.source context.start (context.start - context.current)) in
    match substring with
    | "and" -> add_non_literal_token AND context
    | "class" -> add_non_literal_token CLASS context
    | "else" -> add_non_literal_token ELSE context
    | "false" -> add_non_literal_token FALSE context
    | "for" -> add_non_literal_token FOR context
    | "fun" -> add_non_literal_token FUN context
    | "if" -> add_non_literal_token IF context
    | "nil" -> add_non_literal_token NIL context
    | "or" -> add_non_literal_token OR context
    | "print" -> add_non_literal_token PRINT context
    | "return" -> add_non_literal_token RETURN context
    | "super" -> add_non_literal_token SUPER context
    | "this" -> add_non_literal_token THIS context
    | "true" -> add_non_literal_token TRUE context
    | "var" -> add_non_literal_token VAR context
    | "while" -> add_non_literal_token WHILE context
    | _ -> add_literal_token IDENTIFIER (Some (IDENTIFIER_LITERAL substring)) context

and then we can add in our scan_tokens clause the last piece.

| alpha when (is_alpha alpha) -> add_identifier_literal advanced_context

And now if you dune runtest one more time the only issue you should get is the call to Scanner.scan_tokens in olox.ml. Just go ahead and open Scanner at the top to fix that.

We now have a working scanner. In the next chapter we'll comment out the unfinished code in olox.ml and write some unit tests.

Crafting Interpreters in OCaml - starting a lexer

Nikhil Thomas — Tue, 21 May 2019 15:26:50 +0000

I am currently working on learning how interpreters work via Bob Nystrom's book Crafting Interpreters. This post is a sample of an ongoing series I'm working on.

To follow along the source material, check out the Scanning chapter of Crafting Interpreters

For ease, I'll recommend you clone down this starter repo. We'll be building a scanner for a Lox implementation in OCaml, which we'll call Olox. Let's create a file called olox.ml. This is going to be our entry point for the application, similar to Lox.java in the source material.

Bob's Java code handles the following three cases:

1) If more than one argument is passed in, output a line telling the user the proper usage and exit.
2) If one argument is passed in, run a file with that name.
3) Else, just open a prompt.

Okay, let's start by writing out the following code in our olox.ml

  let main = fun _ -> match Array.length Sys.argv with
    | 0 -> run_prompt ()
    | 1 -> run_file (Array.get Sys.argv 0)
    | _ -> print_endline "Usage: olox [script]"; exit 64;

We're pattern matching on the length of the arguments vector passed in. Sys.argv takes an array of strings that we can use. If no arguments are passed in, we run a prompt. If one is passed in, we run a file with that first element. Else, we'll print an error and exit. We can't really run this code, since we have two undefined functions in run_prompt and run_file but we're just following along.

So now need to define those two functions. Bob's implementation defers run_file to a function called run by reading the bytes out of a file. run_prompt also just takes a line from input and calls run. So we now need to define those three functions.

Let's add the following in our module above our main function

  let run source =
    let tokens = Scanner.scan_tokens in
    List.iter (fun token -> print_endline token) tokens

  let run_prompt = fun _ ->
    while true do
      print_string "> ";
      let input = read_line ()
      in run input;
    done

  let run_file filename =
    let channel = open_in filename in
    try
      (* read entire file *)
      let line = really_input_string channel (in_channel_length channel) in
      run line;
      flush stdout;
      close_in channel
    with e ->
      close_in_noerr channel;
      raise e

Like Bob's Java code, we have a run function that just gets tokens from a scanner - in his case, an instance of a Scanner class. We'll just use a to-be-defined module. Then we'll just iterate over the returned tokens and print them out.

Our run_prompt function will print a string as a prompt, then read in the next line and pass it to our run function.

Our run_file function takes some filename and creates an input channel, positioned at the beginning of the file. It then gets the entirety of the file by reading in_channel_length channel number of characters, then passes into run. For clarity, see the following type signatures.

val really_input_string : in_channel -> int -> string
val in_channel_length : in_channel -> int

really_input_string takes a channel and an int, and returns a string. in_channel_length returns the length of a channel.

So far so good! If you were to copy and paste this into utop, you'd error on the Scanner module. That's fine - feel free to replace run with something like let run = print_endline and test all those functions. In fact, let's try it right now. Create a file called test.md and add the following code.

Hello, world!
This is the second line!
Now on line 3 with spec!@l characters

In your terminal, run utop and copy and paste the following code which replaces run with a simple print.

let run = print_endline

let run_prompt = fun _ ->
  while true do
    print_string "> ";
    let input = read_line ()
    in run input;
  done

let run_file filename =
  let channel = open_in filename in
  try
    (* read entire file *)
    let line = really_input_string channel (in_channel_length channel) in
    run line;
    flush stdout;
    close_in channel
  with e ->
    close_in_noerr channel;
    raise e

Try running run_file "test.md";; and then run_prompt ();; Anything in your prompt should be returned back. Neat! Now ctrl+D to exit.

Next up is error handling! Bob makes the following point and I think it's very valid

The other reason I pulled the error reporting out here instead of stuffing it into the scanner and other phases where the error occurs is to remind you that it’s a good engineering practice to separate the code that generates the errors from the code that reports them.

However, in the interest of not having a global mutable variable, and keeping some of my logic contained in the scanner (for now), I'm going to go ahead and handle all error management in the scanner. This way we can maintain all our scanner logic (line number, character positions) safely isolated and still report on it.

Let's jump right into it. Create a file called scanner.ml. Bob's examples creates classes for Token and TokenType. In our FP world, those can just be types that our scanner knows about so we'll wrap it all up inside one file. If we need to refactor later we can.

Looking at Token.java in the source, we see a giant enum. When I see enum, I think variant types - read up here if you need. Let's take the enum and create a variant type in our scanner.

module Scanner = struct
  type token_type =
    (* single-character tokens *)
    | LEFT_PAREN
    | RIGHT_PAREN
    | LEFT_BRACE
    | RIGHT_BRACE
    | COMMA
    | DOT
    | MINUS
    | PLUS
    | SEMICOLON
    | SLASH
    | STAR

    (* One or two character tokens *)
    | BANG
    | BANG_EQUAL
    | EQUAL
    | EQUAL_EQUAL
    | GREATER
    | GREATER_EQUAL
    | LESS
    | LESS_EQUAL

    (* Literals *)
    | IDENTIFIER
    | STRING
    | NUMBER
    (* Keywords *)
    | AND
    | CLASS
    | ELSE
    | FALSE
    | FUN
    | FOR
    | IF
    | NIL
    | OR
    | PRINT
    | RETURN
    | SUPER
    | THIS
    | TRUE
    | VAR
    | WHILE
    | EOF
end

Just to quote section 4.2.2,

There are lexemes for literal values—numbers and strings and the like. Since the scanner has to walk each character in the literal to correctly identify it, it can also convert it to the real runtime value that will be used by the interpreter later.

Before we move on, we'll need to have some way of wrapping literals. Our token is going to want to have a reference of token type AND optional literals - e.g. a token could be of type TRUE with no literal, or of type NUMBER with a literal 2. So, let's start by just making two types for literals - string and number

  type literal_type = STRING_LITERAL of string | NUMBER_LITERAL of float

This doesn't solve all our problems, but at least we now have some idea of what a literal can be. Moving on to make our token, we should define a type that represents a token. Bob's Token class has a type of TokenType, a lexeme of String, a literal of some Object, and a line of Int. We can do something similar with

type token = {
  lexeme: string;
  literal: literal_type option;
  line: int;
  token_type: token_type;
}

Nikhil why is that literal an option? Well, as we had mentioned before - a token does not need to contain a literal. There is no literal for the token_type VAR, so we may not need a literal in our token. Options represent that. Real World OCaml's chapter on options is a great primer for more info.

Lets take a moment to look at the initial Scanner code in section 4.4. The file defined a class Scanner that has a field source, a string that represents the code we're scanning. scanTokens takes a list of tokens, checks to see if we're at the end of the source and if not, scans tokens. Once at the end, we add a token representing the end of the file and return the list of tokens. We also have the use of a helper function that determines if we're at the end of the source code.

We see that the original Java code has some fields for use. Let's embrace our FP-world and rather than create a class, we're going to create a type that represents some record of fields. We can then ensure all our functions take and emit that type.

type scanner_context = {
  source: string;
  start: int;
  current: int;
  line: int;
}

Now that we have a type that contains all the fields we know about, let's define our methods. To start, let's create an interface file. Create a file called scanner.mli with the following

module Scanner : sig
  type token_type

  type literal_type

  type token

  type scanner_context

  val scan_tokens: string -> token list

  val is_at_end: scanner_context -> bool
end

In our interface, I'll be using abstract types. type token and type scanner_context now hide the implementation of the type from any module that implements this signature. You can read more about them on the OCaml website and this Cornell class's notes.

Our signatures implement what Bob's Java code does - is_at_end returns true or false for the state of the application. scan_tokens will go through the source code and return all the tokens.

Let's prove that our interface actually does something! Open dune and replace with the following code

(executable
  (name olox)
  (libraries oUnit)
)

(alias
  (name    runtest)
  (deps    (:x olox.exe))
  (action  (run %{x})))

Now just run dune build and dune runtest. You should see the following errors.

File "scanner.ml", line 1:
Error: The implementation scanner.ml
       does not match the interface .olox.eobjs/byte/scanner.cmi:
       ...
       In module Scanner:
       The value `is_at_end' is required but not provided
       File "scanner.mli", line 56, characters 2-40: Expected declaration
       In module Scanner:
       The value `scan_tokens' is required but not provided
       File "scanner.mli", line 54, characters 2-48: Expected declaration

There's a bit more above it but let's come back to that later. Our interface works! We stated that the module must have two specific functions but did not implement them. Now to do that.

We'll first write is_at_end. The function takes our wrapping context and returns a boolean. I wrote

let is_at_end ctx = ctx.current >= (String.length ctx.source)

Then we'll have our scan_tokens function. This function takes just the source code string as an input, and will return a list of tokens. Somewhere in the middle we'll need to wrap up the rest of our context. OCaml has local let bindings we can use for this. We also now realize we need to maintain a running list of tokens that we're adding. Let's add tokens to our scanner_context. In the definition of type scanner_context just add tokens: token list; inside.

Looking at Bob's implementation, we have a few more pieces of information. We have a scanToken function that does...something. We can at least assume it changes the value of current globally due to the reset inside the loop. We also have some addition of an EOF token. Let's sketch out what a scan_token function might look like. Given that it'll change two values, current and our token list, let's have it receive and output a scanner_context. In our .mli file add

  val scan_token: scanner_context -> scanner_context

Bob's token addition basically just instantiates a token object and adds it to the global list. Let's do the same, by writing a function add_token that takes all the fields of a token as well as context and returns the new context.

  val add_token: token_type -> string -> literal_type option -> int -> scanner_context -> scanner_context

Okay! We have some loosely defined code interfaces. Let's implement. In scanner.ml we'll do the eaier of the two first.

let add_token token_type lexeme literal line ctx =
  {ctx with tokens = ctx.tokens @ [{
      token_type;
      lexeme;
      literal;
      line
    }]
  }

There's a performance issue here where OCaml's list appending operator (either @ or List.append) runs in O(n) time by walking through the length of the first list. It's not ideal but that's what we get for using a linked list. For now, we'll ignore this and come back to it when it's a performance issue.

Our next function will be our scanning. Look at Bob's implementation. In words - he gets the next character, checks to see what it is, then adds a token. I'm going to break this into three functions - one function to just increment the current counter, one to get the next character, and our add token above.

We can add the following two interfaces

  val advance: scanner_context -> scanner_context

  val current_char: scanner_context -> char option

And then define our functions

  let advance context = {context with current = context.current + 1}

  let current_char context =
    try Some (String.get context.source context.current) with Invalid_argument _ -> None

I'm using an option for the current_char because it's possible to get an out of bounds exception on string access, and it's better to just be safe than sorry.

We also have sone unary function addToken that Bob defines, that just defers to a binary function. I'm going to define these two functions as either adding a literal, or a nonliteral. That means we'll need a function add_literal_token and add_non_literal_token - the former takes both a token_type and Some literal and the latter can defer to the former with a None. We're going to again have context passed along as the last argument in order to make pipelining our functions easy.

val add_literal_token: token_type -> literal_type option -> scanner_context -> scanner_context

val add_non_literal_token: token_type -> scanner_context -> scanner_context

Great. Now to just write those little helpers...

let add_literal_token token_type literal_type context =
  let text = (String.sub context.source context.start (context.current - context.start)) in
  add_token token_type text literal_type context.line context

let add_non_literal_token token_type context = add_literal_token token_type None context

We create a substring from the start position and capture the difference between start and current, then add the token. String.sub in OCaml takes a start and length, rather than a start and end so we need to do a little math.

Now that we have these, we can write out our scan_token function and finally write scan_tokens. Again, since we see that scan_token in Bob's example cares about two fields - the current character, and the token list, let's pass in our context and get out context.

val scan_token: scanner_context -> scanner_context

let scan_token context =
  let advanced_context = advance context in
  match (current_char advanced_context) with
  | Some '(' -> add_non_literal_token LEFT_PAREN advanced_context
  | Some ')' -> add_non_literal_token RIGHT_PAREN advanced_context
  | Some '{' -> add_non_literal_token LEFT_BRACE advanced_context
  | Some '}' -> add_non_literal_token RIGHT_BRACE advanced_context
  | Some ',' -> add_non_literal_token COMMA advanced_context
  | Some '.' -> add_non_literal_token DOT advanced_context
  | Some '-' -> add_non_literal_token MINUS advanced_context
  | Some '+' -> add_non_literal_token PLUS advanced_context
  | Some ';' -> add_non_literal_token SEMICOLON advanced_context
  | Some '*' -> add_non_literal_token STAR advanced_context
  | _ -> failwith "Disallowed character"

WHEW. That's a whole lot of work but we did it. We now have a way to scan tokens from a string. Now for the fun part.

In our next post let's try to write more matching cases. And if we're lucky, some tests.