Commit 4f3996cf authored by Armillon Damien's avatar Armillon Damien
Browse files

Merge remote-tracking branch 'le-remote-d-origine/master'

parents 20825100 7169d5c1
all: main.native
include opts.mk
.PHONY: main.native
src/config.ml: configure
./configure
src/config.ml: configure opts.mk
./configure ${CONF_OPTS}
main.native: src/config.ml
make -C alpaga
......@@ -23,4 +25,4 @@ clean:
make -C tests clean
test: main.native
OCAMLRUNPARAM=b make -C tests
make -C tests
#!/bin/bash
LEX_HAND="true"
ALPAGA_PARSER="true"
while [[ $# -gt 0 ]]
do
key="$1"
case $key in
-l|--lex-hand)
LEX_HAND="true"
shift
;;
-L|--lex-ocamllex)
LEX_HAND="false"
shift
;;
-a|--alpaga-parser)
ALPAGA_PARSER="true"
shift
;;
-m|--menhir-parser)
ALPAGA_PARSER="false"
shift
;;
*) # unknown option
shift # past argument
;;
esac
done
RUNTIME=$(pwd)/runtime
RVAS=$(which -a riscv64-unknown-linux-gnu-as riscv64-unknown-elf-as riscv64-linux-gnu-as 2>/dev/null | grep -v "not found" | head -n1)
......@@ -14,4 +44,5 @@ echo "let qemu64 = \"${QEMU64}\"" >> src/config.ml
echo "let rv_as = \"${RVAS}\"" >> src/config.ml
echo "let rv_ld = \"${RVLD}\"" >> src/config.ml
echo "let os_target = \"linux\"" >> src/config.ml
echo "let lex_hand = $LEX_HAND" >> src/config.ml
echo "let alpaga_parser = $ALPAGA_PARSER" >> src/config.ml
CONF_OPTS=
# Use handwritten lexer
CONF_OPTS+=-l
# Use ocamllex lexer
#CONF_OPTS+=-L
# Use alpaga parser
CONF_OPTS+=-a
# Use menhir parser
#CONF_OPTS+=-m
......@@ -7,4 +7,5 @@ PKG logs.lwt
PKG batteries
PKG yojson
PKG websocket
PKG websocket-lwt-unix
\ No newline at end of file
PKG websocket-lwt-unix
PKG menhirLib
\ No newline at end of file
include ../opts.mk
SRC=archi.ml ast.ml builtins.ml config.ml cfg_constprop.ml cfg_dead_assign.ml \
cfg.ml cfg_print.ml cfg_gen.ml cfg_liveness.ml cfg_nop_elim.ml cfg_run.ml \
elang.ml elang_print.ml elang_gen.ml elang_run.ml e_regexp.ml \
......@@ -22,8 +24,8 @@ test_lexer: archi.ml config.ml e_regexp.ml lexer_generator.ml symbols.ml test_le
dot -Tsvg /tmp/dfa.dot -o /tmp/dfa.svg
dot -Tsvg /tmp/nfa.dot -o /tmp/nfa.svg
config.ml: ../configure
cd .. && ./configure
config.ml: ../configure ../opts.mk
cd .. && ./configure ${CONF_OPTS}
clean:
rm -rf _build
......
true: debug
true: bin_annot
<runtime>: -traverse
<*>: package(lwt lwt.unix logs logs.lwt batteries yojson websocket websocket-lwt-unix)
<*>: package(lwt lwt.unix logs logs.lwt batteries yojson websocket websocket-lwt-unix menhirLib)
true: thread
<tykernel>: -traverse
\ No newline at end of file
true: use_menhir, explain, table
<tykernel>: -traverse
{
open Symbols
exception SyntaxError of string
exception Eof
}
let digit = ['0'-'9']
let letter = ['a'-'z' 'A'-'Z']
let id = letter (digit|letter|'_')*
rule token = parse
| [' ' '\t' '\r'] { token lexbuf }
| '\n' { Lexing.new_line lexbuf; token lexbuf }
| ("0x" ['0'-'9''a'-'f''A'-'F']+) as i { SYM_INTEGER (int_of_string i) }
| ['0'-'9']+ as i { SYM_INTEGER (int_of_string i) }
| '+' { SYM_PLUS }
| "->" { SYM_ARROW }
| "&&" { SYM_BOOL_AND }
| "||" { SYM_BOOL_OR }
| "!" { SYM_BOOL_NOT }
| '&' { SYM_BITWISE_AND }
| '~' { SYM_BIT_NOT }
| '-' { SYM_MINUS }
| '*' { SYM_ASTERISK }
| "//" { single_line_comment lexbuf }
| "/*" { multi_line_comment lexbuf }
| '/' { SYM_DIV }
| '.' { SYM_POINT }
| "void" { SYM_VOID }
| "char" { SYM_CHAR }
| "int" { SYM_INT }
| "print" { SYM_PRINT }
| "struct" { SYM_STRUCT }
| "if" { SYM_IF }
| "else" { SYM_ELSE }
| "alloc" { SYM_ALLOC }
| "==" { SYM_EQUALITY }
| "=" { SYM_ASSIGN }
| "while" { SYM_WHILE }
| "return" { SYM_RETURN }
| id as s { SYM_IDENTIFIER s}
| '{' { SYM_LBRACE }
| '}' { SYM_RBRACE }
| '(' { SYM_LPARENTHESIS }
| ')' { SYM_RPARENTHESIS }
| '[' { SYM_LBRACKET }
| ']' { SYM_RBRACKET }
| ';' { SYM_SEMICOLON }
| ',' { SYM_COMMA }
| ">=" { SYM_GEQ }
| "<=" { SYM_LEQ }
| '>' { SYM_GT }
| '<' { SYM_LT }
| "!=" { SYM_NOTEQ }
| '^' { SYM_XOR }
| '%' { SYM_MOD }
| '\'' { parse_char lexbuf }
| '"' { read_string (Buffer.create 17) lexbuf }
| eof { SYM_EOF }
| _ as x { failwith (Printf.sprintf "unexpected char '%c' at %s \n" x (string_of_position (Lexing.lexeme_start_p lexbuf)))}
and parse_char = parse
| "\\n'" { SYM_CHARACTER '\n' }
| "\\0'" { SYM_CHARACTER (char_of_int 0) }
| "\\r'" { SYM_CHARACTER '\r' }
| "\\t'" { SYM_CHARACTER '\t' }
| _ as c '\'' { SYM_CHARACTER c}
| _ as x { failwith (Printf.sprintf "unexpected char literal '%c'\n" x) }
and read_string buf =
parse
| '"' { SYM_STRING (Buffer.contents buf) }
| '\\' '/' { Buffer.add_char buf '/'; read_string buf lexbuf }
| '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf }
| '\\' 'b' { Buffer.add_char buf '\b'; read_string buf lexbuf }
| '\\' 'f' { Buffer.add_char buf '\012'; read_string buf lexbuf }
| '\\' 'n' { Buffer.add_char buf '\n'; read_string buf lexbuf }
| '\\' 'r' { Buffer.add_char buf '\r'; read_string buf lexbuf }
| '\\' 't' { Buffer.add_char buf '\t'; read_string buf lexbuf }
| [^ '"' '\\']+
{ Buffer.add_string buf (Lexing.lexeme lexbuf);
read_string buf lexbuf
}
| _ { raise (SyntaxError ("Illegal string character: " ^ Lexing.lexeme lexbuf)) }
| eof { raise (SyntaxError ("String is not terminated")) }
and single_line_comment = parse
| ['\n' '\r'] { Lexing.new_line lexbuf; token lexbuf }
| _ { single_line_comment lexbuf }
and multi_line_comment = parse
| "*/" { token lexbuf }
| '\n' { Lexing.new_line lexbuf; multi_line_comment lexbuf }
| _ {multi_line_comment lexbuf}
......@@ -91,6 +91,8 @@ let speclist =
("-nostart", Arg.Set nostart, "Don't output _start code.");
("-nostats", Arg.Set nostats, "Don't output stats.");
("-nomul", Arg.Unit (fun _ -> has_mul := false), "Target architecture without mul instruction.");
("-lex-hand", Arg.Unit (fun _ -> Options.handwritten_lexer := true), "Use handwritten lexer generator");
("-lex-auto", Arg.Unit (fun _ -> Options.handwritten_lexer := false), "Use OCamlLex lexer");
("-linux", Arg.Unit (fun _ -> target := Linux), "emit linux syscalls");
("-xv6", Arg.Unit (fun _ -> target := Xv6), "emit xv6 syscalls");
("--", Arg.Rest (fun p -> params := int_of_string p::!params), "Run parameters.")
......@@ -180,6 +182,7 @@ let _ =
set_default ltl_dump basename ".ltl";
end;
Printexc.record_backtrace true;
let compiler_res =
try
pass_tokenize input >>= fun tokens ->
......
......@@ -37,3 +37,5 @@ let no_linear_dse = ref false
let alloc_order_st = ref true
let naive_regalloc = ref true
let rig_dump : string option ref = ref None
let handwritten_lexer = ref Config.lex_hand
let alpaga_parser = ref Config.alpaga_parser
open Yaccparser
open Generated_parser
open Report
open Utils
open Options
open Ast
open Symbols
let parse = parse_S
let to_yacc_token = function
| SYM_EOF -> Yaccparser.SYM_EOF
| SYM_IDENTIFIER(s) -> Yaccparser.SYM_IDENTIFIER s
| SYM_INTEGER(i) -> Yaccparser.SYM_INTEGER i
| SYM_VOID -> Yaccparser.SYM_VOID
| SYM_CHAR -> Yaccparser.SYM_CHAR
| SYM_INT -> Yaccparser.SYM_INT
| SYM_STRUCT -> Yaccparser.SYM_STRUCT
| SYM_SEMICOLON -> Yaccparser.SYM_SEMICOLON
| SYM_POINT -> Yaccparser.SYM_POINT
| SYM_IF -> Yaccparser.SYM_IF
| SYM_ELSE -> Yaccparser.SYM_ELSE
| SYM_PLUS -> Yaccparser.SYM_PLUS
| SYM_MINUS -> Yaccparser.SYM_MINUS
| SYM_ASTERISK -> Yaccparser.SYM_ASTERISK
| SYM_DIV -> Yaccparser.SYM_DIV
| SYM_EQUALITY -> Yaccparser.SYM_EQUALITY
| SYM_ASSIGN -> Yaccparser.SYM_ASSIGN
| SYM_LPARENTHESIS -> Yaccparser.SYM_LPARENTHESIS
| SYM_RPARENTHESIS -> Yaccparser.SYM_RPARENTHESIS
| SYM_LBRACE -> Yaccparser.SYM_LBRACE
| SYM_RBRACE -> Yaccparser.SYM_RBRACE
| SYM_WHILE -> Yaccparser.SYM_WHILE
| SYM_RETURN -> Yaccparser.SYM_RETURN
| SYM_COMMA -> Yaccparser.SYM_COMMA
| SYM_LT -> Yaccparser.SYM_LT
| SYM_LEQ -> Yaccparser.SYM_LEQ
| SYM_GT -> Yaccparser.SYM_GT
| SYM_GEQ -> Yaccparser.SYM_GEQ
| SYM_NOTEQ -> Yaccparser.SYM_NOTEQ
| SYM_MOD -> Yaccparser.SYM_MOD
| SYM_BOOL_NOT -> Yaccparser.SYM_BOOL_NOT
| SYM_BOOL_AND -> Yaccparser.SYM_BOOL_AND
| SYM_BOOL_OR -> Yaccparser.SYM_BOOL_OR
| SYM_ARROW -> Yaccparser.SYM_ARROW
| SYM_BITWISE_OR -> Yaccparser.SYM_BITWISE_OR
| SYM_BITWISE_AND -> Yaccparser.SYM_BITWISE_AND
| SYM_BIT_NOT -> Yaccparser.SYM_BIT_NOT
| SYM_XOR -> Yaccparser.SYM_XOR
| SYM_CHARACTER(c) -> Yaccparser.SYM_CHARACTER c
| SYM_STRING(s) -> Yaccparser.SYM_STRING s
| SYM_LBRACKET -> Yaccparser.SYM_LBRACKET
| SYM_RBRACKET -> Yaccparser.SYM_RBRACKET
| SYM_ALLOC -> Yaccparser.SYM_ALLOC
| SYM_PRINT -> Yaccparser.SYM_PRINT
| SYM_EXTERN -> Yaccparser.SYM_EXTERN
| SYM_INCLUDE(s) -> Yaccparser.SYM_INCLUDE s
| SYM_AMPERSAND -> Yaccparser.SYM_AMPERSAND
let advance (l: ('a list * 'a list)) : ('a * ('a list * 'a list)) option =
let lbef, laft = l in
match laft with
[] -> None
| a::r -> Some (a, (a::lbef, r))
let back (l: ('a list * 'a list)) : ('a list * 'a list) option =
let lbef, laft = l in
match lbef with
[] -> None
| a::r -> Some ((r, a::laft))
let menhir_parser (toks: (Symbols.token * Lexing.position option) list) () =
let mtoks = ref ([], toks) in
let get_tok () =
match advance !mtoks with
| None -> (Yaccparser.SYM_EOF, Lexing.dummy_pos, Lexing.dummy_pos)
| Some ((t, p), l) ->
mtoks := l;
(to_yacc_token t, Lexing.dummy_pos, Lexing.dummy_pos)
in
let mparser = MenhirLib.Convert.Simplified.traditional2revised Yaccparser.main in
match mparser get_tok with
| ast -> OK (ast, [])
| exception Yaccparser.Error ->
match back !mtoks with
| None -> Error (Printf.sprintf "Parser error while reading '???'\n")
| Some (lbef, laft) ->
Error (Printf.sprintf "Parser error while reading '%s'\n"
(String.concat " " (List.map (fun (t, _) -> string_of_symbol t) (take 20 laft)))
)
let parser toks () =
if !Options.alpaga_parser
then parse toks ()
else menhir_parser toks ()
let pass_parse tokens =
match parse tokens () with
match parser tokens () with
| Error msg -> record_compile_result ~error:(Some msg) "Parsing"; Error msg
| OK (ast, tokens) ->
record_compile_result "Parsing";
......
......@@ -5,10 +5,31 @@ open Utils
open Options
open Symbols
let tokenize file =
let tokenize_handwritten file =
Printf.printf "Handwritten lexer\n";
Lexer_generator.tokenize_file file >>= fun tokens ->
OK (List.map (fun tok -> (tok, None)) tokens)
let tokenize_ocamllex file =
Printf.printf "OCamlLex lexer\n";
let ic = open_in file in
let lexbuf = Lexing.from_channel ic in
lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with pos_fname = file };
let rec get_symbols () =
let s = Lexer.token lexbuf in
let ss = (s, Lexing.lexeme_start_p lexbuf) in
if s = SYM_EOF
then [ss]
else ss :: get_symbols ()
in
let l = get_symbols () in
close_in ic;
OK (List.map (fun (tok, pos) -> (tok, Some pos)) l)
let tokenize file =
if !Options.handwritten_lexer
then tokenize_handwritten file
else tokenize_ocamllex file
let pass_tokenize file =
tokenize file >>* (fun msg ->
......
%{
(* open Symbols *)
open Ast
%}
%token SYM_EOF
%token SYM_VOID SYM_CHAR SYM_INT SYM_STRUCT SYM_POINT SYM_BOOL_NOT SYM_BOOL_AND SYM_BOOL_OR
%token SYM_ARROW SYM_BITWISE_OR SYM_BITWISE_AND SYM_BIT_NOT SYM_XOR SYM_LBRACKET SYM_RBRACKET
%token SYM_ALLOC SYM_EXTERN SYM_AMPERSAND
%token<char> SYM_CHARACTER
%token<string> SYM_STRING
%token<string> SYM_INCLUDE
%token<string> SYM_IDENTIFIER
%token<int> SYM_INTEGER
%token SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD
%token SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE
%token SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA SYM_PRINT
%token SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ
%left SYM_EQUALITY SYM_NOTEQ
%left SYM_GEQ SYM_LEQ SYM_LT SYM_GT
%left SYM_PLUS SYM_MINUS
%left SYM_ASTERISK SYM_DIV SYM_MOD
%nonassoc UMINUS
%start main
%type <Ast.tree> main
%%
main:
| fundefs SYM_EOF { Node(Tlistglobdef, $1) }
;
fundefs:
| fundef fundefs { $1 :: $2 }
| { [] }
;
fundef:
identifier SYM_LPARENTHESIS lparams SYM_RPARENTHESIS instr {
let fargs = $3 in
let instr = $5 in
Node (Tfundef, [$1; Node (Tfunargs, fargs) ; instr ])
}
;
identifier:
SYM_IDENTIFIER { StringLeaf ($1) }
;
integer : SYM_INTEGER { IntLeaf ($1) };
lparams :
identifier rest_params { Node (Targ, [$1]) :: $2 }
| { [] };
rest_params :
SYM_COMMA identifier rest_params {
Node (Targ, [$2]) :: $3
}
| { [] };
instrs :
| instr instrs { $1 :: $2 }
| { [] };
linstrs :
SYM_LBRACE instrs SYM_RBRACE { Node (Tblock, $2) };
instr :
identifier SYM_ASSIGN expr SYM_SEMICOLON {
Node (Tassign, [Node (Tassignvar,[$1; $3])])
}
| SYM_IF SYM_LPARENTHESIS expr SYM_RPARENTHESIS linstrs ntelse { Node (Tif, [$3; $5; $6]) }
| SYM_WHILE SYM_LPARENTHESIS expr SYM_RPARENTHESIS instr { Node( Twhile, [$3; $5]) }
| SYM_RETURN expr SYM_SEMICOLON { Node(Treturn, [$2]) }
| SYM_PRINT expr SYM_SEMICOLON { Node(Tprint, [$2]) }
| linstrs { $1 };
ntelse :
SYM_ELSE linstrs { $2 }
| { Node(Tblock, []) };
expr :
| expr SYM_EQUALITY expr { Node (Tceq, [$1; $3]) }
| expr SYM_NOTEQ expr { Node (Tne, [$1; $3]) }
| expr SYM_PLUS expr { Node (Tadd, [$1; $3]) }
| expr SYM_MINUS expr { Node (Tsub, [$1; $3]) }
| expr SYM_ASTERISK expr { Node (Tmul, [$1; $3]) }
| expr SYM_DIV expr { Node (Tdiv, [$1; $3]) }
| expr SYM_MOD expr { Node (Tmod, [$1; $3]) }
| expr SYM_LT expr { Node (Tclt, [$1; $3]) }
| expr SYM_GT expr { Node (Tcgt, [$1; $3]) }
| expr SYM_LEQ expr { Node (Tcle, [$1; $3]) }
| expr SYM_GEQ expr { Node (Tcge, [$1; $3]) }
| SYM_MINUS expr %prec UMINUS { Node (Tneg, [$2])}
| integer { Node(Tint, [$1])}
| identifier { $1 }
| SYM_LPARENTHESIS expr SYM_RPARENTHESIS { $2 }
;
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