Skip to content

Instantly share code, notes, and snippets.

@tkob tkob/AbsPeyton.ml
Created Mar 12, 2014

Embed
What would you like to do?
An OCaml implementation of "Parsing distfix operators" (Simon Peyton Jones 1986) http://dl.acm.org/citation.cfm?id=5659
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"
{
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 }
########################################################################
# 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
########################################################################
# 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: .
%{
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) }
;
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 ();;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.