Commit e424ca5b authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][EVAL] Parser is now in Camlp4

parent 1854c887
(* TODO: Update this grammar if needed.
Formaly add comments.
Formaly add comments. *)
expr = id
| integer
| expr expr
| abstr
| "(" expr "," expr ")"
| "match" expr "with" "|" expr ["&" type_id] "->" expr branches
abstr = "let" ["fun"] id "=" expr
| "let" ["fun"] "_" "=" expr
abstr = "fun" id params "=" expr
params = (* empty *)
| id params
branches = (* empty *)
| "|" expr ["&" type_id] "->" expr branches
id = [A-Za-z][A-Za-z0-9]*
id = [A-Za-z_][A-Za-z0-9-_]*
integer = [0-9]+
OCAMLC ?= ocamlc
COMPILER ?= ocamlbuild
ROOTDIR ?= ../..
SRCDIR ?= src
EXTDIR ?= $(SRCDIR)/externals
INCDIR ?= -I $(SRCDIR) -I $(EXTDIR)
FILES = lexer.ml parser.ml
SRCFILES = $(FILES:%=$(SRCDIR)/%) $(SRCDIR)/main.ml
OBJSRCFILES = $(SRCFILES:%.ml=%.cmo)
INCFILES = $(FILES:%=$(SRCDIR)/%i)
OBJINCFILES = $(INCFILES:%.mli=%.cmi)
# TODO: Improve this, we have to add twice an external file in this Makefile
INEXTFILES = misc/custom.ml misc/encodings.ml types/ident.ml\
compile/lambda.mli compile/lambda.ml misc/ns.ml misc/ns.mli misc/upool.ml\
misc/upool.mli types/sortedList.ml types/sortedList.mli types/compunit.ml\
types/compunit.mli types/types.mli types/types.ml
INEXTSRCFILES = custom.ml encodings.ml upool.mli upool.ml ns.mli ns.ml\
sortedList.mli sortedList.ml ident.ml compunit.mli compunit.ml types.mli\
types.ml lambda.mli lambda.ml
EXTFILES = $(INEXTFILES:%=$(ROOTDIR)/%)
EXTSRCFILES = $(INEXTSRCFILES:%=$(EXTDIR)/%)
TMPEXTOBJFILES = $(EXTSRCFILES:%.ml=%.cmo)
EXTOBJFILES = $(TMPEXTOBJFILES:%.mli=%.cmi)
OTHERFILES = str.cma
RM ?= rm -f
OUT ?= lambdaparser
OBJFILES = $(OBJSRCFILES) $(OBJINCFILES) $(EXTOBJFILES)
OUT ?= lambda.native
.PHONY: clean check test
all: _import $(EXTOBJFILES) $(OBJINCFILES) $(OBJSRCFILES)
$(OCAMLC) $(INCDIR) -o $(OUT) $(OTHERFILES) $(EXTOBJFILES) $(OBJSRCFILES)
all: _import
$(COMPILER) -use-ocamlfind $(OUT)
_import:
@echo -n "Copying external files..."
......@@ -42,16 +25,11 @@ _import:
@echo "done"
clean:
$(RM) $(OBJFILES) $(EXTSRCFILES) $(EXTINCFILES) $(SRCDIR)/main.cmi $(OUT)
$(RM) $(OUT)
$(RM) -r _build
test $(EXTDIR) = "src" || test $(EXTDIR) = "." || $(RM) -r $(EXTDIR)
check: test
test: all
tests/test.sh
%.cmo: %.ml
$(OCAMLC) -c $(INCDIR) -o $@ $<
%.cmi: %.mli
$(OCAMLC) -c $(INCDIR) -o $@ $<
<src>: include
<src/lambda*>: pp(camlp4orf.opt), package(camlp4.lib)
open Printf
type expr =
| Apply of expr * expr
| Abstract of string * string list * expr
| Var of string
| Int of int
| Pair of expr * expr
| Match of expr * (expr * string option * expr) list;;
module ExprParser = struct
open Camlp4.PreCast
let exp_eoi = Gram.Entry.mk "exp_eoi"
EXTEND Gram
GLOBAL: exp_eoi;
exp_eoi:[[e = expression; `EOI -> e]];
expression:
[
"abstr" RIGHTA
[ "fun"; x = LIDENT; p = LIST0 param; "->"; e = expression ->
Abstract(x, p, e)
| "match"; e1 = expression; "with"; b = LIST1 branch -> Match(e1, b) ]
| "pair" LEFTA
[ e1 = expression; ","; e2 = expression -> Pair(e1,e2)
| e1 = expression ; "."; e2 = expression -> Apply(e1,e2) ]
| "paren"
[ "("; e = expression; ")" -> e ]
| "var"
[ x = LIDENT -> Var(x) ]
| "int"
[ x = INT -> Int(int_of_string x) ]
];
param:[[p = LIDENT -> p]];
branch:
[
"branches" LEFTA
[ "|"; t = expression; "->"; e = expression -> (t, None, e)
| "|"; t = expression; "&"; x = LIDENT; "->"; e = expression ->
(t, Some x, e) ]
];
END;;
let of_string s = Gram.parse_string exp_eoi (Loc.mk "<string>") s
let os = of_string
end;;
exception InvalidBranches;;
let rec print_expr expr = match expr with
| Apply(e1, e2) -> printf "Apply("; print_expr e1; printf ", ";
print_expr e2; printf ")"
| Abstract(fname, params, e) -> printf "Abstract(%s" fname;
print_params params; printf ", "; print_expr e; printf ")"
| Var(vname) -> printf "Var(%s)" vname
| Int(i) -> printf "Int(%d)" i
| Pair(e1, e2) -> printf "Pair("; print_expr e1; printf ", "; print_expr e2;
printf ")"
| Match(e, b) -> printf "Match("; print_expr e; printf ", ";
print_branches b; printf ")"
and print_params params = match params with
| p :: rest -> printf " %s" p; print_params rest
| [] -> ()
and print_branches b = match b with
| (br, None, exp) :: rest -> printf "("; print_expr br; printf ", ";
print_expr exp; printf ")"; print_branches rest
| (br, Some x, exp) :: rest -> printf "("; print_expr br; printf " & %s, " x;
print_expr exp; printf ")"; print_branches rest
| [] -> ();;
let rec expr_to_string expr = match expr with
| Apply(e1, e2) -> (expr_to_string e1) ^ " . " ^ (expr_to_string e2)
| Abstract(fname, params, e) -> "fun " ^ fname ^ (params_to_string params)
^ " -> " ^ (expr_to_string e)
| Var(vname) -> vname
| Int(i) -> string_of_int i
| Pair(e1, e2) -> "(" ^ (expr_to_string e1) ^ ", " ^ (expr_to_string e2)
^ ")"
| Match(e, b) -> "match " ^ (expr_to_string e) ^ " with"
^ (branches_to_string b)
and params_to_string params = match params with
| p :: rest -> " " ^ p ^ (params_to_string rest)
| [] -> ""
and branches_to_string b = match b with
| (br, None, exp) :: rest -> "\n| " ^ (expr_to_string br) ^ " -> "
^ (expr_to_string exp) ^ (branches_to_string rest)
| (br, Some x, exp) :: rest -> "\n| " ^ (expr_to_string br) ^ " & " ^ x
^ " -> " ^ (expr_to_string exp) ^ (branches_to_string rest)
| [] -> "";;
let str = "fun firsts x y -> match x,y with
| (a,_),(b,_) -> a,b (* This (* is (* a nested *) *) comment *)
| _ -> x (* That doesn't make any sense *)" in
let expr = ExprParser.of_string str in
printf "Original: %s\nExpr: " str;
print_expr expr;
printf "\nResult: %s\n" (expr_to_string expr)
open Printf
open Str
type token =
| Keyword of string
| Operator of string
| Id of string
| Int of int
module StrMap = Map.Make(String);;
let rec gen_keywords keywords list = match list with
| el :: rest -> gen_keywords (StrMap.add el (Keyword el) keywords) rest
| [] -> keywords
let rec gen_ops ops list = match list with
| el :: rest -> gen_ops (StrMap.add el (Operator el) ops) rest
| [] -> ops
let keywords = gen_keywords (StrMap.add "let" (Keyword "let") StrMap.empty)
[ "fun"; "match"; "with"; "_" ]
let ops = gen_ops (StrMap.add "=" (Operator "=") StrMap.empty)
[ "("; ")"; ","; "|"; "&"; "->"; ";" ]
(* Regexp to find an operator in a string *)
let strops = "[=(),|&;]\\|->"
let rec print_expr expr = match expr with
| Keyword str :: rest -> printf "Keyword: %s\n" str; print_expr rest
| Operator str :: rest -> printf "Operator: %s\n" str; print_expr rest
| Id str :: rest -> printf "Id: %s\n" str; print_expr rest
| Int i :: rest -> printf "Int: %d\n" i; print_expr rest
| [] -> printf ""
(* TODO: Add support for comments *)
let lex str =
let rec _lex_noblanks list res = match list with
| Delim d :: rest -> _lex_noblanks rest (res @ [Operator d])
| Text t :: rest ->
(try _lex_noblanks rest (res @ [Int (int_of_string t)]);
with Failure _ -> _lex_noblanks rest (res @ [Id t]))
| [] -> res
in
let rec _lex list res = match list with
| el :: rest ->
(try let k = StrMap.find el keywords in
_lex rest (res @ [k])
with Not_found ->
try let o = StrMap.find el ops in
_lex rest (res @ [o])
with Not_found ->
_lex rest (res @ (_lex_noblanks (Str.full_split
(Str.regexp strops) el) []))
)
| [] -> res
in
_lex (Str.split (Str.regexp "[ \t\n]+") str) []
type token =
| Keyword of string
| Operator of string
| Id of string
| Int of int
val lex : string -> token list
val print_expr : token list -> unit
open Printf
let load_file f =
let ic = open_in f in
let n = in_channel_length ic in
let s = String.create n in
really_input ic s 0 n;
close_in ic;
s
let ignore a =
printf "Ignoring...\n"
let _ =
if Array.length Sys.argv - 1 <> 0 then
let str = load_file Sys.argv.(1) in
let tokens = Lexer.lex str in
let env = [||] in
let locals = [||] in
Lexer.print_expr tokens;
Parser.parse_expr env locals tokens
open Printf
open Lexer
let rec parse_expr env locals expr = match expr with
| Keyword str :: rest -> printf "%s" ("Keyword: " ^ str ^ "\n");
parse_expr env locals rest
| Operator str :: rest -> printf "%s" ("Operator: " ^ str ^ "\n");
parse_expr env locals rest
| Id str :: rest -> printf "%s" ("Id: " ^ str ^ "\n");
parse_expr env locals rest
| Int i :: rest -> printf "%s%d%s" "Int: " i "\n"; parse_expr env locals rest
| [] -> printf ""
val parse_expr : Lambda.Env ref array -> Lambda.Local ref array ->
Lexer.token list -> Lambda.expr list
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment