An OCaml implementation of "Parsing distfix operators" (Simon Peyton Jones 1986) http://dl.acm.org/citation.cfm?id=5659

AbsPeyton.ml

type var = string
type exp =
  LetExp of var * exp * exp
| IfExp of exp * exp * exp
| FunExp of var * exp
| AppExp of exp * exp
| IntExp of int
| VarExp of string
| PrimAdd | PrimSub | PrimMul | PrimDiv

let rec show = function
  LetExp(var, e1, e2) -> "LetExp(" ^ var ^ ", " ^ show e1 ^ ", " ^ show e2 ^ ")"
| IfExp(e1, e2, e3) -> "IfExp(" ^ show e1 ^ ", " ^ show e2 ^ ", " ^ show e3 ^ ""
| FunExp(var, e) -> "FunExp(" ^ var ^ ", " ^ show e ^ ")"
| AppExp(e1, e2) -> "AppExp(" ^ show e1 ^ " , " ^ show e2 ^ ")"
| IntExp(i) -> "IntExp(" ^ string_of_int i ^ ")"
| VarExp(v) -> "VarExp(" ^ v ^ ")"
| PrimAdd -> "PrimAdd"
| PrimSub -> "PrimSub"
| PrimMul -> "PrimMul"
| PrimDiv -> "PrimDiv"

LexPeyton.mll

{
open ParPeyton
open Lexing

let incr_lineno (lexbuf:Lexing.lexbuf) : unit =
    let pos = lexbuf.lex_curr_p in
        lexbuf.lex_curr_p <- { pos with
            pos_lnum = pos.pos_lnum + 1;
            pos_bol = pos.pos_cnum;
        }

let drop s = let len = String.length s - 1 in String.sub s 1 len
let chop s = let len = String.length s - 1 in String.sub s 0 len
let untick s = let len = String.length s - 2 in  String.sub s 1 len

}

let l = ['a'-'z' 'A'-'Z' '\192' - '\255'] # ['\215' '\247']    (*  isolatin1 letter FIXME *)
let c = ['A'-'Z' '\192'-'\221'] # ['\215']    (*  capital isolatin1 letter FIXME *)
let s = ['a'-'z' '\222'-'\255'] # ['\247']    (*  small isolatin1 letter FIXME *)
let d = ['0'-'9']                (*  digit *)
let i = l | d | ['_' '\'']          (*  identifier character *)
let u = ['\000'-'\255']           (* universal: any character *)

rule token =
    parse
        | '(' { LParen }
        | ')' { RParen }
        | "let" { Let }
        | '=' { Eq }
        | "in" { In }
        | "if" { If }
        | "then" { Then }
        | "else" { Else }
        | "fun" { Fun }
        | '+' { Add }
        | '-' { Sub }
        | '*' { Mul }
        | '/' { Div }
        | '`' i+ { let id = lexeme lexbuf in Postfix (drop id) }
        | '`' i+ '`' { let id = lexeme lexbuf in Infix (untick id) }
        | l i* '`' { let id = lexeme lexbuf in Prefix (chop id) }
        | '`' { Postfix "" }
        | l i* ('`' i+)* '`'? {let id = lexeme lexbuf in Ident id}
        | d+ {let i = lexeme lexbuf in Integer (int_of_string i)}
        | [' ' '\t'] {token lexbuf}
        | '\n' {incr_lineno lexbuf; token lexbuf}
        | eof { Eof }

OMakefile

########################################################################
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this file, to deal in the File without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the File, and to permit persons to whom the
# File is furnished to do so, subject to the following condition:
#
# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR
# THE USE OR OTHER DEALINGS IN THE FILE.

########################################################################
# The standard OMakefile.
# You will usually need to modify this file for your project.

# Delete this line once you have configured this file
# eprintln($(CWD)/OMakefile is not configured)

########################################################################
# Phony targets are scoped, so you probably want to declare them first.
#

# .PHONY: all install clean

########################################################################
# Subdirectories.
# You may want to include some subdirectories in this project.
# If so, define the subdirectory targets and uncomment this section.
#

# .SUBDIRS:

########################################################################
# C configuration.
# Delete this section if you are not building C files.
#

################################################
# Configuration.  You might want to modify any of these
# configuration variables.
#

# CFLAGS +=
# ASFLAGS +=
# LDFLAGS +=
# INCLUDES +=

################################################
# Uncomment the following section if you want
# to build a C program in the current directory.
#

# CFILES[] =
#    file1
#    main
#
# MAIN = main
#
# .DEFAULT: $(CProgram $(MAIN), $(CFILES))

################################################
# Uncomment the following section if you want to build a C library
# in the current directory.
#

# LIBFILES[] =
#    file1
#    file2
#
# LIB = libxxx
#
# .DEFAULT: $(StaticCLibrary $(LIB), $(LIBFILES))

########################################################################
# OCaml configuration.
# Delete this section if you are not building OCaml files.
#

################################################
# Configuration.  You may want to modify any of these configuration
# variables.
#

#
# This project requires ocamlfind (default - false).
#
# USE_OCAMLFIND = true
#
# OCAMLPACKS[] =
#    pack1
#    pack2
#
# if $(not $(OCAMLFIND_EXISTS))
#    eprintln(This project requires ocamlfind, but is was not found.)
#    eprintln(You need to install ocamlfind and run "omake --configure".)
#    exit 1

#
# Include path
#
# OCAMLINCLUDES +=

#
# Compile native or byte code?
#
# The default values are defined as follows:
#
# NATIVE_ENABLED = $(OCAMLOPT_EXISTS)
# BYTE_ENABLED = $(not $(OCAMLOPT_EXISTS))

#
# Various options
#
# OCAMLFLAGS    +=
# OCAMLCFLAGS   +=
# OCAMLOPTFLAGS +=
# OCAML_LINK_FLAGS +=
# OCAML_BYTE_LINK_FLAGS +=
# OCAML_NATIVE_LINK_FLAGS +=

################################################
# Generated files
#
# Workaround for the fact that ocamldep does not pay attention to .mll
# and .mly files.
#
OCamlGeneratedFiles(LexPeyton.ml ParPeyton.ml ParPeyton.mli)

################################################
# Build an OCaml library
#

# FILES[] =
#    file1
#    file2
#
# LIB = main
#
# .DEFAULT: $(OCamlLibrary $(LIB), $(FILES))

################################################
# Build an OCaml program
#

FILES[] =
  AbsPeyton
  LexPeyton
  ParPeyton
  TestPeyton

PROGRAM = TestPeyton
# OCAML_LIBS +=
# OCAML_CLIBS +=
# OCAML_OTHER_LIBS +=
# OCAML_LIB_FLAGS +=
#
.DEFAULT: $(OCamlProgram $(PROGRAM), $(FILES))

.PHONY: clean
clean:
        rm -f \
        $(filter-proper-targets $(glob $(addsuffix .*, $(FILES)))) \
        $(PROGRAM) $(PROGRAM).run $(PROGRAM).opt

OMakeroot

########################################################################
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this file, to deal in the File without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the File, and to permit persons to whom the
# File is furnished to do so, subject to the following condition:
#
# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR
# THE USE OR OTHER DEALINGS IN THE FILE.

########################################################################
# The standard OMakeroot file.
# You will not normally need to modify this file.
# By default, your changes should be placed in the
# OMakefile in this directory.
#
# If you decide to modify this file, note that it uses exactly
# the same syntax as the OMakefile.
#

#
# Include the standard installed configuration files.
# Any of these can be deleted if you are not using them,
# but you probably want to keep the Common file.
#
open build/C
open build/OCaml
open build/LaTeX

#
# The command-line variables are defined *after* the
# standard configuration has been loaded.
#
DefineCommandVars()

#
# Include the OMakefile in this directory.
#
.SUBDIRS: .

ParPeyton.mly

%{
open AbsPeyton
open Lexing

exception Parse_error of Lexing.position * Lexing.position

let rec slide exp word = match exp with
  VarExp(f) -> VarExp(f ^ "`" ^ word)
| AppExp(e, a) -> AppExp(slide e word, a)
| e -> failwith (AbsPeyton.show e ^ " + " ^ word)

let parse_error _ =
  let start_pos = Parsing.symbol_start_pos () in
  let end_pos = Parsing.symbol_end_pos () in
  failwith (Printf.sprintf "Parse error at %d.%d-%d.%d"
    start_pos.pos_lnum (start_pos.pos_cnum - start_pos.pos_bol)
    end_pos.pos_lnum (end_pos.pos_cnum - end_pos.pos_bol))

%}

%token Eof
%token LParen
%token RParen
%token Let
%token Eq
%token In
%token If
%token Then
%token Else
%token Fun
%token Add
%token Sub
%token Mul
%token Div
%token <string> Ident
%token <int> Integer
%token <string> Prefix
%token <string> Postfix
%token <string> Infix

%start exp
%type <AbsPeyton.exp> exp

%%
exp : exp0 Eof { $1 }

exp0 : Let Ident Eq exp0 In exp0 { LetExp($2, $4, $6) }
     | If exp0 Then exp0 Else exp0 { IfExp($2, $4, $6) }
     | Fun Ident Eq exp0 { FunExp($2, $4) }
     | exp1 { $1 }

exp1 : exp1 Postfix { AppExp(VarExp($2), $1) }
     | exp2 { $1 }

exp2 : exp2 Infix exp3 { AppExp(AppExp(VarExp($2), $1), $3) }
     | exp3 { $1 }

exp3 : exp3 Add exp4 { AppExp(AppExp(PrimAdd, $1), $3) }
     | exp3 Sub exp4 { AppExp(AppExp(PrimSub, $1), $3) }
     | exp4 { $1 }

exp4 : exp4 Mul exp5 { AppExp(AppExp(PrimMul, $1), $3) }
     | exp4 Div exp5 { AppExp(AppExp(PrimDiv, $1), $3) }
     | exp5 { $1 }

exp5 : exp5 exp6 { AppExp($1, $2) }
     | exp6 { $1 }

exp6 : Integer { IntExp($1) }
     | Ident { VarExp($1) }
     | distexp Postfix { slide $1 $2 }
     | LParen exp0 RParen { $2 }

distexp : Prefix exp3 { AppExp(VarExp($1), $2) }
        | distexp Infix exp3 { AppExp(slide $1 $2, $3) }
;

TestPeyton.ml

open Lexing

let parse (c : in_channel) : AbsPeyton.exp =
  ParPeyton.exp LexPeyton.token (Lexing.from_channel c)
;;

let main () =
  let filename = Sys.argv.(1) in
  let channel = open_in filename in
  print_endline (AbsPeyton.show (parse channel))
;;

main ();;