Ocamlyacc

Ten artykuł od 2021-02 wymaga zweryfikowania podanych informacji. Należy podać wiarygodne źródła, najlepiej w formie przypisów bibliograficznych. Część lub nawet wszystkie informacje w artykule mogą być nieprawdziwe. Jako pozbawione źródeł mogą zostać zakwestionowane i usunięte. Po wyeliminowaniu niedoskonałości należy usunąć szablon {{Dopracować}} z tego artykułu.

Ocamlyacc – generator parserów dla języka Ocaml, wzorowany na programach typu yacc dla C.

Operowanie na drzewach składniowych w Ocamlu jest o wiele łatwiejsze niż w C. Połączenie tych dwóch cech - generatora parserów i języka z dobrymi możliwościami przekształceń symbolicznych, czyni z Ocamla jeden z najwygodniejszych w użyciu języków pisania parserów.

Programy w ocamlyacc mają rozszerzenie .mly

Ocamlyacc używany jest zwykle w połączeniu z generatorem lekserów ocamllex, wzorowanym na programach typu lex dla C. Pliki źródłowe ocamllex mają rozszerzenie .mll.

Przykład

Napiszemy parser, który interpretuje pliki języka K, nazwanego tak ze względu na duże wizualne podobieństwo do C. K nie jest zbyt ambitnym językiem (inaczej interpreter znacznie przerastałby parser), ale umożliwia czytanie wejścia (get), wykonywanie obliczeń (tutaj funkcja Fibonacciego) oraz drukowanie wyników (p):

pre1 = 0;
pre2 = 1;
n = 0;
get nmax;
while (n < nmax)
{
    new = pre1 + pre2;
    pre2 = pre1;
    pre1 = new;
    n += 1
};
p pre1

Lekser

Zawartość pliku lexer.mll:

{
    open Parser
}
let space = [' ' '\n' '\t']
let digit = ['0'-'9']
let alpha = ['a'-'z' 'A'-'Z']
rule token = parse
    space +     { token lexbuf }
    | 'p'       { PRINT }
    | "if"      { IF }
    | "else"    { ELSE }
    | "while"   { WHILE }
    | "proc"    { PROC }
    | "call"    { CALL }
    | "get"     { GET }
    | alpha (digit|alpha) *     { ID (Lexing.lexeme lexbuf) }
    | digit +   { INT (int_of_string (Lexing.lexeme lexbuf)) }
    | '+'       { PLUS }
    | '-'       { MINUS }
    | '*'       { TIMES }
    | '('       { LPAREN }
    | ')'       { RPAREN }
    | '{'       { LBRACE }
    | '}'       { RBRACE }
    | ';'       { SEMI }
    | "=="      { EQEQ }
    | '='       { EQ }
    | ">"       { GT }
    | ">="      { GE }
    | "<"       { LT }
    | "<="      { LE }
    | "+="      { PLUS_EQ }
    | "-="      { MINUS_EQ }
    | "*="      { TIMES_EQ }
    | eof       {  EOF }

Jak widać ogólna struktura prostego pliku .mll to:

{
  kod w ocamlu, przepisywany bezpośrednio na wyjście
}
let x = kilka_deklaracji
let y = ułatwiających
let z = pisanie_reguł
rule token = parse
      reguła     { wyrażenie_zwracające_symbol }
   | inna_reguła { inne_wyrażenie_zwracające_symbol }
   | itd         { itd }
   | eof         { można_dzięki_temu_przekazać_eof_do_parsera }

Parser

Plik .mly zaczyna się kodem, który będzie bezpośrednio przepisany, zawartym między %{ i %}. Potem następuje deklaracja typu tokenów - tokeny proste deklaruje się %token NAZWA, tokeny niosące dodatkowe informacje %token <typ> NAZWA. Potem trzeba zdefiniować regułę startową %start reguła i jej typ %type <typ> reguła. Typy innych reguł Ocaml potrafi zazwyczaj inferować, jednak można je też zdeklarować.

Potem następuje %% i zaczynają się reguły postaci:

nazwa:
      możliwa struktura       { wyrażenie dla tej struktury }
    | inna możliwa struktura  { wyrażenie dla innej struktury }
    | itd                     { itd }
;;

Przykład parsera dla K:

%{
open Hashtbl;;
open Program;;
%}

%token <string> ID
%token <int> INT
%token LPAREN RPAREN
%token LBRACE RBRACE
%token PLUS MINUS TIMES
%token EQEQ GT GE LT LE
%token PLUS_EQ MINUS_EQ TIMES_EQ
%token IF ELSE WHILE
%token SEMI
%token EOF
%token PRINT
%token EQ
%token PROC CALL GET

%start program
%type <Program.stree list> program

%%

program:
    decls_and_stmts EOF
        { $1 }
;;
decl:
    PROC ID stmt {PROC_TREE ($2,$3)}
;;
decls_and_stmts:
    decl
        { [$1] }
    | stmt
        { [$1] }
    | stmt SEMI decls_and_stmts
        { $1 :: $3 }
    | decl SEMI decls_and_stmts
        { $1 :: $3 }
;;
stmtgroup:
      stmt { [$1] }
    | stmt SEMI stmtgroup { $1 :: $3 }
;;
stmt:
      stmt_a1 { $1 }
    | stmt_a2 { $1 }
;;
stmt_a1:
      /* empty */ { NOOP_TREE }
    | LBRACE stmtgroup RBRACE { STMT_GROUP_TREE $2 }
    | PRINT expr { PRINT_TREE $2 }
    | CALL ID { CALL_TREE $2 }
    | GET ID { GET_TREE $2 }
    | ID EQ expr { ASSIGN_TREE ($1,$3) }
    | ID PLUS_EQ expr { ASSIGN_TREE ($1,(PLUS_TREE((ID_TREE $1),$3))) }
    | ID MINUS_EQ expr { ASSIGN_TREE ($1,(MINUS_TREE((ID_TREE $1),$3))) }
    | ID TIMES_EQ expr { ASSIGN_TREE ($1,(TIMES_TREE((ID_TREE $1),$3))) }
    | WHILE LPAREN expr RPAREN stmt_a1 { WHILE_TREE($3,$5)}
    | IF LPAREN expr RPAREN stmt_a1 ELSE stmt_a1 { IF_TREE($3,$5,$7) }
;;
stmt_a2:
      WHILE LPAREN expr RPAREN stmt_a2 { WHILE_TREE($3,$5)}
    | IF LPAREN expr RPAREN stmt { IF_TREE($3,$5,NOOP_TREE) }
    | IF LPAREN expr RPAREN stmt_a1 ELSE stmt_a2 { IF_TREE($3,$5,$7) }
;;

expr:
    expr_p0 { $1 }
;;
expr_p0:
      expr_p0 EQEQ expr_p1 { EQEQ_TREE ($1,$3) }
    | expr_p0 GT expr_p1 { GT_TREE ($1,$3) }
    | expr_p0 LT expr_p1 { GT_TREE ($3,$1) }
    | expr_p0 GE expr_p1 { GE_TREE ($1,$3) }
    | expr_p0 LE expr_p1 { GE_TREE ($3,$1) }
    | expr_p1 { $1 }
;;
expr_p1:
      expr_p1 PLUS expr_p2 { PLUS_TREE ($1,$3) }
    | expr_p1 MINUS expr_p2 { MINUS_TREE ($1,$3) }
    | expr_p2 { $1 }
;;
expr_p2:
      expr_p2 TIMES expr_p3 { TIMES_TREE ($1,$3) }
    | expr_p3 { $1 }
;;
expr_p3:
      LPAREN expr_p0 RPAREN { $2 }
    | ID  { ID_TREE $1 }
    | INT { INT_TREE $1 }
;;

W tym przypadku priorytety operatorów zdefiniowano bezpośrednio na poziomie gramatyki. Można użyć zamiast tego analogicznie jak w yacc deklaracji %left, %right, %nonassoc i %prec

stmt_a1 i stmt_a2 rozwiązują interesujący dangling else problem i są warte specjalnej uwagi.

program.ml

Plik program.ml zawiera wnętrzności programu. Nie są one interesujące z punktu widzenia budowy parsera, jednak należy je zamieścić ze względu na kompletność helloworlda.

Typy xtree - drzewo przedstawiające wyrażenie i stree - drzewo przedstawiające polecenie są używane przez parser.

(* autohash *)
type autohash = { autohash_last: int ref; autohash_h:(string,int)Hashtbl.t; };;

let autohash_get ah s =
    try Hashtbl.find ah.autohash_h s
    with Not_found -> (
            ah.autohash_last := 1 + !(ah.autohash_last);
            Hashtbl.add ah.autohash_h s !(ah.autohash_last);
            !(ah.autohash_last);
    );;

(* types *)
type xtree =
      ID_TREE of string
    | INT_TREE of int
    | PLUS_TREE of xtree * xtree
    | MINUS_TREE of xtree * xtree
    | TIMES_TREE of xtree * xtree
    | EQEQ_TREE of xtree * xtree
    | GT_TREE of xtree * xtree
    | GE_TREE of xtree * xtree
;;
type stree =
      ASSIGN_TREE of string * xtree
    | NOOP_TREE
    | IF_TREE of xtree * stree * stree
    | WHILE_TREE of xtree * stree
    | PRINT_TREE of xtree
    | STMT_GROUP_TREE of stree list
    | PROC_TREE of string * stree
    | CALL_TREE of string
    | GET_TREE of string
;;

(* interpreter *)
type ienv = { ienv_var : (string,int) Hashtbl.t; ienv_proc : (string,stree) Hashtbl.t; }

let rec xtree_eval e = function
      INT_TREE a -> a
    | ID_TREE a -> (Hashtbl.find e.ienv_var a)
    | PLUS_TREE (a, b) -> (xtree_eval e a) + (xtree_eval e b)
    | MINUS_TREE (a, b) -> (xtree_eval e a) - (xtree_eval e b)
    | TIMES_TREE (a, b) -> (xtree_eval e a) * (xtree_eval e b)
    | EQEQ_TREE (a,b) -> let av = (xtree_eval e a) in let bv = (xtree_eval e b) in
            if (av = bv) then 1 else 0;
    | GT_TREE (a,b) -> let av = (xtree_eval e a) in let bv = (xtree_eval e b) in
            if (av > bv) then 1 else 0;
    | GE_TREE (a,b) -> let av = (xtree_eval e a) in let bv = (xtree_eval e b) in
            if (av >= bv) then 1 else 0;
;;
let rec stmt_eval e = function
      PRINT_TREE a -> print_string "> "; print_int(xtree_eval e a); print_newline();
    | IF_TREE (a,b,c) -> if ((xtree_eval e a) != 0) then (stmt_eval e b) else (stmt_eval e c);
    | NOOP_TREE -> ()
    | ASSIGN_TREE (a,b) -> (Hashtbl.add e.ienv_var a (xtree_eval e b))
    | WHILE_TREE (a,b) -> while ((xtree_eval e a) != 0) do stmt_eval e b done
    | STMT_GROUP_TREE (a) -> stmt_group_eval e a
    | PROC_TREE (a,b) -> (Hashtbl.add e.ienv_proc a b)
    | CALL_TREE (a) -> stmt_eval e (Hashtbl.find e.ienv_proc a)
    | GET_TREE (a) -> (Hashtbl.add e.ienv_var a (read_int()))
and stmt_group_eval e = function
      [] -> ()
    | h::t -> (stmt_eval e h); (stmt_group_eval e t)
;;
let rec stmts_eval e = function
      [] -> ()
    | h::t -> stmt_eval e h ; stmts_eval e t;
;;
let program_eval p =
    let e = { ienv_var = Hashtbl.create 16; ienv_proc =  Hashtbl.create 16} in
        stmts_eval e p
;;

Procedura główna

Plik kk.ml zawiera "procedurę główną" i wywołuje nasz parser.

open Program
let _ =
    if Array.length Sys.argv <= 1 then
        print_string ("Usage: "^(Sys.argv.(0))^" <k program>\n")
    else
        let p = Parser.program Lexer.token (Lexing.from_channel (open_in Sys.argv.(1))) in
            program_eval p
;;

Makefile

W tworzeniu Makefile pomocny może być program ocamldep, choć nie radzi on sobie bezpośrednio z plikami .mll i .mly.

all: kk
kk_opt: program.cmx lexer.cmx parser.cmx kk.cmx
        ocamlopt -o $@ $^
kk: program.cmo lexer.cmo parser.cmo kk.cmo
        ocamlc -o $@ $^
%.ml: %.mll
        ocamllex $<
%.mli %.ml: %.mly
        ocamlyacc $<
%.cmo: %.ml
        ocamlc -c $<
%.cmx: %.ml
        ocamlopt -c $<
%.cmi: %.mli
        ocamlc -c $<

kk.cmo: lexer.cmo parser.cmi program.cmo
kk.cmx: lexer.cmx parser.cmx program.cmx
lexer.cmo: parser.cmi
lexer.cmx: parser.cmx
parser.cmo: program.cmo parser.cmi
parser.cmx: program.cmx parser.cmi
parser.cmi: program.cmo

Użycie

$ ./kk fib.k
20
> 6765
$