Initial commit

Author: chrisnevers

.gitignore

@@ -0,0 +1,32 @@
+
+*.annot
+*.cmo
+*.cma
+*.cmi
+*.a
+*.o
+*.cmx
+*.cmxs
+*.cmxa
+
+# ocamlbuild working directory
+_build/
+
+# ocamlbuild targets
+*.byte
+*.native
+
+# oasis generated files
+setup.data
+setup.log
+
+# Merlin configuring file for Vim and Emacs
+.merlin
+
+# Dune generated files
+*.install
+
+# Local OPAM switch
+_opam/
+notes
+*DS_Store

Makefile

@@ -0,0 +1,28 @@
+all: build
+
+build:
+	@dune build @all
+	@cp -f _build/default/bin/main.exe /usr/local/bin/test_chungus
+	@echo "\n"
+	@test_chungus
+
+install:
+	@dune install
+
+test: build
+	@dune runtest
+
+doc: build
+	@opam install odoc
+	@dune build @doc
+
+clean:
+	@dune clean
+
+# Create a release on Github, then run git pull
+publish:
+	@git tag 1.0
+	@git push origin 1.0
+	@git pull
+	@opam pin .
+	@opam publish https://github.com/chrisnevers/chungus/archive/1.0.tar.gz

README.md

@@ -0,0 +1,62 @@
+# Chungus Parser Combinator
+
+A simple monadic parser combinator library with position information.
+
+## Example
+
+`bin/main.ml` demonstrates using the parser to parse a simple untyped lambda calculus.
+
+```ocaml
+open Chungus.Parser
+open Chungus.Combinator
+open Chungus.Chars
+
+type exp =
+  | Var     of position * string
+  | Int     of position * int
+  | Lambda  of position * exp * exp
+  | Apply   of position * exp * exp
+
+let rec show_exp e =
+  match e with
+  | Var (_, id) -> id
+  | Int (_, i)  -> string_of_int i
+  | Lambda (_, i, b) -> "λ " ^ show_exp i ^ " -> " ^ show_exp b
+  | Apply (_, f, a)  -> "(" ^ show_exp f ^ ") (" ^ show_exp a ^ ")"
+
+let identifier () =
+  let  pos   = get_position () in
+  let* ident = lower <@> many alpha_digit in
+  return @@ Var (pos, stringify ident)
+
+let int () =
+  let pos = get_position () in
+  let* i  = many1 digit in
+  return @@ Int (pos, stringify i |> int_of_string)
+
+let terminal () =
+  return =<< (identifier <?> int)
+
+let rec lambda () =
+  ignore_spaces ();
+  let pos = get_position () in
+  let* id = str "λ" >> spaces >> identifier in
+  let* ex = spaces >> str "->" >> expression in
+  return @@ Lambda (pos, id, ex)
+
+and non_app () =
+  lambda <?> terminal <?> parens expression >>= return
+
+and app l r =
+    ignore_spaces ();
+    Apply (get_position (), l, r)
+
+and expression () = return =<< chainl (spaces >> non_app) (lift app)
+
+let () =
+  from_string "(λ chrisNevers -> chrisNevers (λ shamone -> hehe)) (λ whenTheImposterIsSus -> 54235)";
+  match expression () with
+  | Ok e -> print_endline (show_exp e)
+  | _    -> print_endline "Failed to parse expression"
+
+```

bin/dune

@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (libraries chungus))

bin/main.ml

@@ -0,0 +1,51 @@
+open Chungus.Parser
+open Chungus.Combinator
+open Chungus.Chars
+
+type exp =
+  | Var     of position * string
+  | Int     of position * int
+  | Lambda  of position * exp * exp
+  | Apply   of position * exp * exp
+
+let rec show_exp e =
+  match e with
+  | Var (_, id) -> id
+  | Int (_, i)  -> string_of_int i
+  | Lambda (_, i, b) -> "λ " ^ show_exp i ^ " -> " ^ show_exp b
+  | Apply (_, f, a)  -> "(" ^ show_exp f ^ ") (" ^ show_exp a ^ ")"
+
+let identifier () =
+  let  pos   = get_position () in
+  let* ident = lower <@> many alpha_digit in
+  return @@ Var (pos, stringify ident)
+
+let int () =
+  let pos = get_position () in
+  let* i  = many1 digit in
+  return @@ Int (pos, stringify i |> int_of_string)
+
+let terminal () =
+  return =<< (identifier <?> int)
+
+let rec lambda () =
+  ignore_spaces ();
+  let pos = get_position () in
+  let* id = str "λ" >> spaces >> identifier in
+  let* ex = spaces >> str "->" >> expression in
+  return @@ Lambda (pos, id, ex)
+
+and non_app () =
+  lambda <?> terminal <?> parens expression >>= return
+
+and app l r =
+    ignore_spaces ();
+    Apply (get_position (), l, r)
+
+and expression () = return =<< chainl (spaces >> non_app) (lift app)
+
+let () =
+  from_string "(λ chrisNevers -> chrisNevers (λ shamone -> hehe)) (λ whenTheImposterIsSus -> 54235)";
+  match expression () with
+  | Ok e -> print_endline (show_exp e)
+  | _    -> print_endline "Failed to parse expression"

chungus.opam

@@ -0,0 +1,18 @@
+
+opam-version: "2.0"
+version: "1.0"
+authors: "Chris Nevers <[email protected]>"
+maintainer: "Chris Nevers <[email protected]>"
+homepage: "https://github.com/chrisnevers/chungus"
+bug-reports: "https://github.com/chrisnevers/chungus/issues"
+dev-repo: "git://github.com/chrisnevers/chungus.git"
+synopsis: ""
+build: [
+  ["dune" "subst"] {pinned}
+  ["dune" "build" "-p" name "-j" jobs]
+]
+
+depends: [
+  "ocaml"
+  "dune" {>= "2.7.1"}
+]

dune-project

@@ -0,0 +1,2 @@
+(lang dune 2.7)
+(name chungus)

lib/Chars.ml

@@ -0,0 +1,96 @@
+open Parser
+open Combinator
+open Stream
+
+let is_lower c =
+  let code = Char.code c in
+  code >= 97 && code <= 122
+
+let is_upper c =
+  let code = Char.code c in
+  code >= 65 && code <= 90
+
+let is_alpha c =
+  is_lower c || is_upper c
+
+let is_digit c =
+  let code = Char.code c in
+  code >= 48 && code <= 57
+
+let is_whitespace c =
+  let code = Char.code c in
+  List.mem code [32; 9; 10; 11; 12; 13]
+
+let newline = "\n"
+
+let crlf    = "\r\n"
+
+let eof     = "\000"
+
+let char f =
+  let stream = get_stream () in
+  match peek stream with
+  | Some a when f a ->
+    let _ = process_char stream in
+    Ok a
+  | _ -> Fail
+
+let str s () =
+  let s_len = String.length s in
+  let stream = get_stream () in
+  let chars = Stream.npeek s_len stream in
+  match s_len == List.length chars with
+  | true  ->
+    if String.compare (stringify chars) s == 0 then
+      let _ = process_chars stream s_len in
+      Ok chars
+    else
+      Fail
+  | false -> Fail
+
+let any_char () =
+  char (fun _ -> true)
+
+let one_of cs =
+  char (fun c -> List.mem c cs)
+
+let none_of cs =
+  char (fun c -> not (List.mem c cs))
+
+let digit () =
+  char (fun c -> is_digit c)
+
+let alpha () =
+  char (fun c -> is_alpha c)
+
+let alpha_digit () =
+  char (fun c -> is_alpha c || is_digit c)
+
+let whitespace () =
+  char (fun c -> is_whitespace c)
+
+let lower () =
+  char (fun c -> is_lower c)
+
+let upper () =
+  char (fun c -> is_upper c)
+
+let spaces = many whitespace
+
+let ignore_spaces () = spaces () |> ignore
+
+let match_char uc () =
+  char (fun c -> c == uc)
+
+let tab = match_char '\t'
+
+let comma = match_char ','
+
+let l_paren = match_char '('
+
+let r_paren = match_char ')'
+
+let end_of_line () =
+  str newline <?> str crlf
+
+let parens e () = between l_paren r_paren e

lib/Combinator.ml

@@ -0,0 +1,75 @@
+open Parser
+
+let many p () =
+  let rec aux () =
+    match p () with
+    | Ok e    ->
+      let* rst = aux in
+      return (e :: rst)
+    | _ -> return []
+  in
+  aux ()
+
+let many1 p () =
+  let rec aux () =
+    match p () with
+    | Ok e    ->
+      let* rst = aux in
+      return (e :: rst)
+    | _ -> return []
+  in
+  let* fst = p in
+  let* rst = aux in
+  return (fst :: rst)
+
+let rec choice ps =
+  match ps with
+  | [] -> Fail
+  | h :: t ->
+    match h () with
+    | Ok a -> Ok a
+    | _    -> choice t
+
+let count i p =
+  let rec aux i () =
+    match i with
+    | 0 -> return []
+    | n ->
+      let* a = p in
+      let* rst = aux (n - 1) in
+      Ok (a :: rst)
+  in
+  aux i ()
+
+let sepBy p sep =
+  let rec aux () =
+    match p () with
+    | Ok e ->
+      begin match sep () with
+      | Ok _ ->
+        let* rst = aux in
+        return (e :: rst)
+      | _ -> return [e]
+      end
+    | _ -> return []
+  in
+  aux ()
+
+let between s e p =
+  let* _  = s in
+  let* p' = p in
+  let* _  = e in
+  return p'
+
+let chainl p op () =
+  let rec aux x : 'a result =
+    let work () =
+      let* f = op in
+      let* y = p in
+      aux (f x y)
+    in
+    let* res = work <?> const x in
+    return res
+  in
+  let* fst = p in
+  aux fst