sexp parsing fun

README.md

A simple boolean language with definitions implemented over Sexp.t

Conclusions:

• Is pretty easy to write a custom sexp_of_t and t_of_sexp functions.
• This lets us to add some sugar over the atoms, I use ?v for variables as an example here
• On top of that we can build superset of S-Expressions language which is easy to parse and very expressive

!!!! from manual !!!!

@TODO: FIX THIS!

You must report failures by raising the Of_sexp_error-exception so that then sexplib’s tools for pinpointing the location of type errors within an s-expression file will work properly.

bin__dune

(executable
 (public_name lang31)
 (name main)
 (libraries lang31))

bin__main.ml

open Lang31.Lang
open Core

let () = 
  let input_lines = In_channel.(input_lines stdin) |> String.concat ~sep:" " in
  parse input_lines
  |> unparse
  |> print_endline

lib__dune

(library
 (libraries core)
 (preprocess (pps ppx_sexp_conv))
 (name lang31))

lib__lang.ml

open Core

type ast =
| Func of (string * string list * ast)
| App of (string * (ast list))
| Var of string
| True
| False
| Int of int
| And of ast * ast
| Or of ast * ast
| Not of ast
(* [@@deriving sexp] *)

let a x = Sexp.Atom x
let l xs = Sexp.List xs
let fmt = Format.sprintf

let rec sexp_of_ast = function
  | Var s -> a (fmt "?%s" s)
  | True -> a "true"
  | False -> a "false"
  | And (x, y) -> l [a "and"; sexp_of_ast x; sexp_of_ast y]
  | Or (x, y) -> l [a "or"; sexp_of_ast x; sexp_of_ast y]
  | Not x -> l [a "not"; sexp_of_ast x]
  | Func (name, args, body) ->
     l [a "define"; a name; l (List.map ~f:a args); sexp_of_ast body]
  | App (f, args) ->
     l ((a f) :: List.map ~f:sexp_of_ast args)
  | Int i -> a (fmt "%d" i)

exception Parser_error of string

let rec ast_of_sexp = function
  | Sexp.Atom "true" -> True
  | Atom "false" -> False
  | Atom v ->
     (match int_of_string v with
     | i -> Int i
     | exception Failure _ ->
        let first_char = String.get v 0 in
        if Char.(first_char <> '?')
        then raise (Parser_error (fmt "invalid atom %s" v));
        Var (String.sub v ~pos:1 ~len:((String.length v) - 1)))
  | List [Atom "and"; a; b] ->
     And (ast_of_sexp a, ast_of_sexp b)
  | List [Atom "or"; a; b] ->
     Or (ast_of_sexp a, ast_of_sexp b)
  | List [Atom "not"; a] ->     
     Not (ast_of_sexp a)
  | List [Atom "define"; Atom name; List arguments; body] as expr ->
     let arguments = List.map ~f:(function Atom a -> a | List _ ->
                                                       raise (Parser_error
                                                              (fmt "invalid arguments list in %s"
                                                               (Sexp.to_string_hum expr)))) arguments in
     Func (name, arguments, ast_of_sexp body)
  | List (Atom fname :: arguments) ->
     App (fname, List.map ~f:ast_of_sexp arguments)
  | sexp -> raise (Parser_error
                   (fmt "invalid expression %s" (Sexp.to_string_hum sexp)))


let show_ast ast =
  ast |> sexp_of_ast |> Sexp.to_string_hum

let parse input =
  Parsexp.Many.parse_string_exn input
  |> List.map ~f:ast_of_sexp

let unparse asts =
  List.map ~f:(fun ast -> sexp_of_ast ast |> Sexp.to_string_hum) asts
  |> String.concat ~sep:"\n"

output.txt

➜  lang31 dune exec bin/main.exe <<EOF
(define pair (a b) (define _ (f) (?f ?a ?b)))
(define add (a b) (+ ?a ?b))
EOF