Skip to content

Instantly share code, notes, and snippets.

@dhilst
Last active February 11, 2024 16:20
Show Gist options
  • Save dhilst/9b2528eed2007bf0f29c430b3e3e614e to your computer and use it in GitHub Desktop.
Save dhilst/9b2528eed2007bf0f29c430b3e3e614e to your computer and use it in GitHub Desktop.
sexp parsing fun

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.

(executable
(public_name lang31)
(name main)
(libraries lang31))
open Lang31.Lang
open Core
let () =
let input_lines = In_channel.(input_lines stdin) |> String.concat ~sep:" " in
parse input_lines
|> unparse
|> print_endline
(library
(libraries core)
(preprocess (pps ppx_sexp_conv))
(name lang31))
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"
➜ lang31 dune exec bin/main.exe <<EOF
(define pair (a b) (define _ (f) (?f ?a ?b)))
(define add (a b) (+ ?a ?b))
EOF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment