From 28875fece2374a41510edbef416311c308695774 Mon Sep 17 00:00:00 2001 From: Siraaj Khandkar Date: Thu, 31 May 2018 15:16:35 -0400 Subject: [PATCH] Complete 1.04.p: add semantic actions to parser FIXME: 2 more shift/reduce conflicts were introduced with the rules for consecutive function and type declarations --- README.md | 4 +- tiger/src/exe/tiger_tests.ml | 4 +- tiger/src/exe/tigerc.ml | 4 +- tiger/src/lib/tiger/tiger.ml | 1 + tiger/src/lib/tiger/tiger_absyn.ml | 144 +++++++ tiger/src/lib/tiger/tiger_absyn.mli | 144 +++++++ tiger/src/lib/tiger/tiger_parser.mly | 496 ++++++++++++++----------- tiger/src/lib/tiger/tiger_position.ml | 21 ++ tiger/src/lib/tiger/tiger_position.mli | 12 + tiger/src/lib/tiger/tiger_symbol.ml | 23 ++ tiger/src/lib/tiger/tiger_symbol.mli | 5 + 11 files changed, 643 insertions(+), 215 deletions(-) create mode 100644 tiger/src/lib/tiger/tiger_absyn.ml create mode 100644 tiger/src/lib/tiger/tiger_absyn.mli create mode 100644 tiger/src/lib/tiger/tiger_position.ml create mode 100644 tiger/src/lib/tiger/tiger_position.mli create mode 100644 tiger/src/lib/tiger/tiger_symbol.ml create mode 100644 tiger/src/lib/tiger/tiger_symbol.mli diff --git a/README.md b/README.md index 4a57bc6..616f735 100644 --- a/README.md +++ b/README.md @@ -42,9 +42,9 @@ Project Plan | [x] | 1.02.e.09 | ---- generate lexer tables from spec | --- | -- | -- | ---------- | ---------- | | [x] | 1.02.e.10 | ---- design better lookahead than Aho | --- | -- | -- | ---------- | ---------- | | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- | -| [x] | 1.03 | -- Parsing | 049 | 02 | 04 | 2018-05-25 | 2018-05-29 | +| [x] | 1.03 | -- Parsing | 049 | 02 | 05 | 2018-05-25 | 2018-05-31 | | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- | -| [ ] | 1.04 | -- Abstract Syntax | 016 | 01 | -- | ---------- | ---------- | +| [x] | 1.04 | -- Abstract Syntax | 016 | 01 | 01 | 2018-05-30 | 2018-05-30 | | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- | | [ ] | 1.05 | -- Semantic Analysis | 021 | 01 | -- | ---------- | ---------- | | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- | diff --git a/tiger/src/exe/tiger_tests.ml b/tiger/src/exe/tiger_tests.ml index ebdec23..d9eb050 100644 --- a/tiger/src/exe/tiger_tests.ml +++ b/tiger/src/exe/tiger_tests.ml @@ -313,8 +313,8 @@ let () = let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in Error msg - | parsetree -> - Ok parsetree + | absyn -> + Ok (Tiger.Absyn.to_string absyn) ) in let bar_sep = String.make 80 '-' in diff --git a/tiger/src/exe/tigerc.ml b/tiger/src/exe/tigerc.ml index fd58a83..708ff17 100644 --- a/tiger/src/exe/tigerc.ml +++ b/tiger/src/exe/tigerc.ml @@ -10,7 +10,7 @@ let () = Printf.printf "Syntax error in file %S, around line: %d, column: %d\n" path_to_program_file pos_lnum (pos_cnum - pos_bol) - | program -> - print_endline program + | absyn -> + print_endline (Tiger.Absyn.to_string absyn) ); close_in ic; diff --git a/tiger/src/lib/tiger/tiger.ml b/tiger/src/lib/tiger/tiger.ml index 577e25d..1ae01c1 100644 --- a/tiger/src/lib/tiger/tiger.ml +++ b/tiger/src/lib/tiger/tiger.ml @@ -1,3 +1,4 @@ +module Absyn = Tiger_absyn module Lexer = Tiger_lexer module Parser = Tiger_parser module Parser_token = Tiger_parser_token diff --git a/tiger/src/lib/tiger/tiger_absyn.ml b/tiger/src/lib/tiger/tiger_absyn.ml new file mode 100644 index 0000000..0161a4b --- /dev/null +++ b/tiger/src/lib/tiger/tiger_absyn.ml @@ -0,0 +1,144 @@ +type pos = Tiger_position.t + +type symbol = Tiger_symbol.t + +type oper = + | PlusOp + | MinusOp + | TimesOp + | DivideOp + | EqOp + | NeqOp + | LtOp + | LeOp + | GtOp + | GeOp + +type exp = + | VarExp of + var + | NilExp + | IntExp of + int + | StringExp of + { string : string + ; pos : pos + } + | CallExp of + { func : symbol + ; args : exp list + ; pos : pos + } + | OpExp of + { left : exp + ; oper : oper + ; right : exp + ; pos : pos + } + | RecordExp of + { fields : (symbol * exp * pos) list + ; typ : symbol + ; pos : pos + } + | SeqExp of + (exp * pos) list + | AssignExp of + { var : var + ; exp : exp + ; pos : pos + } + | IfExp of + { test : exp + ; then' : exp + ; else' : exp option + ; pos : pos + } + | WhileExp of + { test : exp + ; body : exp + ; pos : pos + } + | ForExp of + { var : symbol + ; escape : bool ref (* Whoa - why a mutable cell in AST? *) + ; lo : exp + ; hi : exp + ; body : exp + ; pos : pos + } + | BreakExp of + pos + | LetExp of + { decs : dec list + ; body : exp + ; pos : pos + } + | ArrayExp of + { typ : symbol + ; size : exp + ; init : exp + ; pos : pos + } +and var = + | SimpleVar of + { symbol : symbol + ; pos : pos + } + | FieldVar of + { var : var + ; symbol : symbol + ; pos : pos + } + | SubscriptVar of + { var : var + ; exp : exp + ; pos : pos + } +and dec = + | FunDecs of (* "FunctionDec" in Appel's code *) + fundec list + | VarDec of + { name : symbol + ; escape : bool ref (* Again, why mutable? *) + ; typ : (symbol * pos) option + ; init : exp + ; pos : pos + } + | TypeDecs of (* "TypeDec" in Appel's code *) + typedec list +and ty = + | NameTy of + { symbol : symbol + ; pos : pos + } + | RecordTy of + field list + | ArrayTy of + { symbol : symbol + ; pos : pos + } +and field = + | Field of + { name : symbol + ; escape : bool ref + ; typ : symbol + ; pos : pos + } +and typedec = + | TypeDec of (* An anonymous record in Appel's code *) + { name : symbol + ; ty : ty + ; pos : pos + } +and fundec = + | FunDec of + { name : symbol + ; params : field list + ; result : (symbol * pos) option + ; body : exp + ; pos : pos + } + +type t = exp + +let to_string _ = "TODO: implement Tiger_absyn.to_string" diff --git a/tiger/src/lib/tiger/tiger_absyn.mli b/tiger/src/lib/tiger/tiger_absyn.mli new file mode 100644 index 0000000..12dc6a8 --- /dev/null +++ b/tiger/src/lib/tiger/tiger_absyn.mli @@ -0,0 +1,144 @@ +type pos = Tiger_position.t + +type symbol = Tiger_symbol.t + +type oper = + | PlusOp + | MinusOp + | TimesOp + | DivideOp + | EqOp + | NeqOp + | LtOp + | LeOp + | GtOp + | GeOp + +type exp = + | VarExp of + var + | NilExp + | IntExp of + int + | StringExp of + { string : string + ; pos : pos + } + | CallExp of + { func : symbol + ; args : exp list + ; pos : pos + } + | OpExp of + { left : exp + ; oper : oper + ; right : exp + ; pos : pos + } + | RecordExp of + { fields : (symbol * exp * pos) list + ; typ : symbol + ; pos : pos + } + | SeqExp of + (exp * pos) list + | AssignExp of + { var : var + ; exp : exp + ; pos : pos + } + | IfExp of + { test : exp + ; then' : exp + ; else' : exp option + ; pos : pos + } + | WhileExp of + { test : exp + ; body : exp + ; pos : pos + } + | ForExp of + { var : symbol + ; escape : bool ref (* Whoa - why a mutable cell in AST? *) + ; lo : exp + ; hi : exp + ; body : exp + ; pos : pos + } + | BreakExp of + pos + | LetExp of + { decs : dec list + ; body : exp + ; pos : pos + } + | ArrayExp of + { typ : symbol + ; size : exp + ; init : exp + ; pos : pos + } +and var = + | SimpleVar of + { symbol : symbol + ; pos : pos + } + | FieldVar of + { var : var + ; symbol : symbol + ; pos : pos + } + | SubscriptVar of + { var : var + ; exp : exp + ; pos : pos + } +and dec = + | FunDecs of (* "FunctionDec" in Appel's code *) + fundec list + | VarDec of + { name : symbol + ; escape : bool ref (* Again, why mutable? *) + ; typ : (symbol * pos) option + ; init : exp + ; pos : pos + } + | TypeDecs of (* "TypeDec" in Appel's code *) + typedec list +and ty = + | NameTy of + { symbol : symbol + ; pos : pos + } + | RecordTy of + field list + | ArrayTy of + { symbol : symbol + ; pos : pos + } +and field = + | Field of + { name : symbol + ; escape : bool ref + ; typ : symbol + ; pos : pos + } +and typedec = + | TypeDec of (* An anonymous record in Appel's code *) + { name : symbol + ; ty : ty + ; pos : pos + } +and fundec = + | FunDec of + { name : symbol + ; params : field list + ; result : (symbol * pos) option + ; body : exp + ; pos : pos + } + +type t = exp + +val to_string : t -> string diff --git a/tiger/src/lib/tiger/tiger_parser.mly b/tiger/src/lib/tiger/tiger_parser.mly index 1bc0ae7..aa0178a 100644 --- a/tiger/src/lib/tiger/tiger_parser.mly +++ b/tiger/src/lib/tiger/tiger_parser.mly @@ -1,5 +1,11 @@ %{ - open Printf + module Ast = Tiger_absyn + module Sym = Tiger_symbol + + let pos () = + Tiger_position.of_lexing_positions + ~pos_start:(Parsing.symbol_start_pos ()) + ~pos_end:(Parsing.symbol_end_pos ()) %} /* Declarations */ @@ -49,340 +55,412 @@ %token WHILE /* from lowest precedence */ -%left THEN -%left ELSE +%nonassoc LOWEST +%nonassoc THEN +%nonassoc ELSE %nonassoc ASSIGN -%left OF DO +%nonassoc OF DO %left OR %left AND %nonassoc EQ NEQ GT LT GE LE %left PLUS MINUS %left TIMES DIVIDE -%nonassoc UMINUS +%nonassoc HIGHEST /* to highest precedence */ -%type program +%type program %start program %% -program: - | exp EOF - { - sprintf "program[%s]" $1 - } - ; +program: exp EOF { $1 }; exp: | NIL - { - "nil[]" - } + { Ast.NilExp } | INT - { - sprintf "int[%d]" $1 - } - | MINUS exp %prec UMINUS - { - sprintf "negation[%s]" $2 - } - | ID LBRACK exp RBRACK OF exp + { Ast.IntExp $1 } + | MINUS exp %prec HIGHEST + { + Ast.OpExp + { left = Ast.IntExp 0 + ; oper = Ast.MinusOp + ; right = $2 + ; pos = pos () + } + } + | lvalue LBRACK exp RBRACK OF exp + { + match $1 with + | Ast.SimpleVar {symbol=typ; _} -> + Ast.ArrayExp + { typ + ; size = $3 + ; init = $6 + ; pos = pos () + } + | Ast.SubscriptVar _ | Ast.FieldVar _ -> + raise Parse_error + } + | ID LBRACE rec_fields_bind RBRACE { let type_id = $1 in - let number_of_elements = $3 in - let initial_value = $6 in - sprintf - "array[type[%s], size[%s], val[%s]]" - type_id number_of_elements initial_value - } - | ID LBRACE rec_field_assignments RBRACE - { - let type_id = $1 in - let rec_field_assignments = $3 in - sprintf - "record[type[%s], rec_field_assignments[%s]]" - type_id rec_field_assignments + let fields = $3 in + let typ = Sym.of_string type_id in + let pos = pos () in + Ast.RecordExp {fields; typ; pos} } | lvalue - { - $1 - } + { Ast.VarExp $1 } | lvalue ASSIGN exp { - sprintf "assign[%s := %s]" $1 $3 + let var = $1 in + let exp = $3 in + let pos = pos () in + Ast.AssignExp {var; exp; pos} } | STRING - { - sprintf "string[%S]" $1 - } - | ID LPAREN RPAREN - { - let id = $1 in - sprintf "fun_call[%s, []]" id - } + { Ast.StringExp {string = $1; pos = pos ()} } | ID LPAREN fun_args RPAREN { - let id = $1 in - let fun_args = $3 in - sprintf "fun_call[%s, %s]" id fun_args + Ast.CallExp + { func = Sym.of_string $1 + ; args = $3 + ; pos = pos () + } } | exp PLUS exp { - sprintf "op_plus[%s + %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.PlusOp + ; right = $3 + ; pos = pos () + } } | exp MINUS exp { - sprintf "op_minus[%s - %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.MinusOp + ; right = $3 + ; pos = pos () + } } | exp TIMES exp { - sprintf "op_times[%s * %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.TimesOp + ; right = $3 + ; pos = pos () + } } | exp DIVIDE exp { - sprintf "op_divide[%s / %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.DivideOp + ; right = $3 + ; pos = pos () + } } | exp EQ exp { - sprintf "op_eq[%s = %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.EqOp + ; right = $3 + ; pos = pos () + } } | exp NEQ exp { - sprintf "op_neq[%s <> %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.NeqOp + ; right = $3 + ; pos = pos () + } } | exp GT exp { - sprintf "op_gt[%s > %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.GtOp + ; right = $3 + ; pos = pos () + } } | exp LT exp { - sprintf "op_lt[%s < %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.LtOp + ; right = $3 + ; pos = pos () + } } | exp GE exp { - sprintf "op_ge[%s >= %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.GeOp + ; right = $3 + ; pos = pos () + } } | exp LE exp { - sprintf "op_le[%s <= %s]" $1 $3 + Ast.OpExp + { left = $1 + ; oper = Ast.LeOp + ; right = $3 + ; pos = pos () + } } | exp AND exp { - sprintf "op_and[%s & %s]" $1 $3 + let e1 = $1 in + let e2 = $3 in + Ast.IfExp + { test = e1 + ; then' = e2 + ; else' = Some (Ast.IntExp 0) + ; pos = pos () + } } | exp OR exp { - sprintf "op_or[%s | %s]" $1 $3 + let e1 = $1 in + let e2 = $3 in + Ast.IfExp + { test = e1 + ; then' = Ast.IntExp 1 + ; else' = Some e2 + ; pos = pos () + } } | IF exp THEN exp ELSE exp { let e1 = $2 in let e2 = $4 in let e3 = $6 in - sprintf "if_then_else[%s, then[%s], else[%s]]" e1 e2 e3 + Ast.IfExp + { test = e1 + ; then' = e2 + ; else' = Some e3 + ; pos = pos () + } } | IF exp THEN exp { - sprintf "if_then[%s, then[%s]]" $2 $4 + let e1 = $2 in + let e2 = $4 in + Ast.IfExp + { test = e1 + ; then' = e2 + ; else' = None + ; pos = pos () + } } | WHILE exp DO exp { - sprintf "while[%s, do[%s]]" $2 $4 + let e1 = $2 in + let e2 = $4 in + Ast.WhileExp + { test = e1 + ; body = e2 + ; pos = pos () + } } | FOR ID ASSIGN exp TO exp DO exp { - let id = $2 in - let e1 = $4 in - let e2 = $6 in - let e3 = $8 in - sprintf "for[%s := %s, to[%s], do[%s]]" id e1 e2 e3 + let var = $2 in + let e1 = $4 in + let e2 = $6 in + let e3 = $8 in + Ast.ForExp + { var = Sym.of_string var + ; escape = ref true + ; lo = e1 + ; hi = e2 + ; body = e3 + ; pos = pos () + } } | BREAK - { - "break[]" - } + { Ast.BreakExp (pos ()) } | LPAREN exps RPAREN - { - sprintf "exps[%s]" $2 - } + { Ast.SeqExp $2 } | LET decs IN exps END { let decs = $2 in let exps = $4 in - sprintf "let[decs[%s], in[exps[%s]]]" decs exps - } - | LPAREN RPAREN - { - (* Perhaps "void"? *) - "unit[]" + Ast.LetExp {decs; body = Ast.SeqExp exps; pos = pos ()} } ; -rec_field_assignments: - | ID EQ exp - { - let id = $1 in - let exp = $3 in - sprintf "%S = %s" id exp - } - | ID EQ exp COMMA rec_field_assignments - { - let id = $1 in - let exp = $3 in - let rec_field_assignments = $5 in - sprintf "%S = %s, %s" id exp rec_field_assignments - } +exps: + | { [] } + | exp { ($1, pos ()) :: [] } + | exp SEMICOLON exps { ($1, pos ()) :: $3 } ; -exps: - | exp - { - let exp = $1 in - sprintf "%s" exp - } - | exp SEMICOLON exps - { - let exp = $1 in - let exps = $3 in - sprintf "%s; %s" exp exps - } +rec_fields_bind: + | ID EQ exp { (Sym.of_string $1, $3, pos ()) :: [] } + | ID EQ exp COMMA rec_fields_bind { (Sym.of_string $1, $3, pos ()) :: $5 } ; decs: - | dec - { - sprintf "%s" $1 - } - | dec decs - { - sprintf "%s %s" $1 $2 - } + | dec { $1 :: [] } + | dec decs { $1 :: $2 } ; dec: - /* Tydec */ + | var_dec { $1 } + | typ_decs %prec LOWEST { Ast.TypeDecs $1 } + | fun_decs %prec LOWEST { Ast.FunDecs $1 } + ; + +typ_decs: + | typ_dec { $1 :: [] } + | typ_dec typ_decs %prec LOWEST { $1 :: $2 } + ; + +typ_dec: | TYPE ID EQ ID { - let type_id_new = $2 in - let type_id_orig = $4 in - sprintf "tydec_alias[from[%s], to[%s]]" type_id_new type_id_orig + let type_id_left = $2 in + let type_id_right = $4 in + let pos = pos () in (* FIXME: rhs id should have its own pos, no? *) + Ast.TypeDec + { name = Sym.of_string type_id_left + ; ty = Ast.NameTy {symbol = Sym.of_string type_id_right; pos} + ; pos + } } - | TYPE ID EQ LBRACE RBRACE + | TYPE ID EQ LBRACE type_fields RBRACE { let type_id = $2 in - sprintf "tydec_empty_record[%s]" type_id - } - | TYPE ID EQ LBRACE tyfields RBRACE - { - let type_id = $2 in - let tyfields = $5 in - sprintf "tydec_record[%s, fields[%s]]" type_id tyfields + let type_fields = $5 in + Ast.TypeDec + { name = Sym.of_string type_id + ; ty = Ast.RecordTy type_fields + ; pos = pos () + } } | TYPE ID EQ ARRAY OF ID { - let type_id = $2 in - let element_type_id = $6 in - sprintf "tydec_array[%s, elements_of_type[%s]]" type_id element_type_id + let type_id = Sym.of_string $2 in + let element_type_id = Sym.of_string $6 in + let pos = pos () in + Ast.TypeDec + { name = type_id + ; ty = Ast.ArrayTy {symbol = element_type_id; pos} + ; pos + } } + ; - /* Vardec */ - | VAR ID ASSIGN exp - { - let id = $2 in - let exp = $4 in - sprintf "vardec[%s, exp[%s]]" id exp - } - | VAR ID COLON ID ASSIGN exp - { - let id = $2 in - let type_id = $4 in - let exp = $6 in - sprintf "vardec[%s, type_id[%s], exp[%s]]" id type_id exp +var_dec: + | VAR ID maybe_type_sig ASSIGN exp + { + let var_id = Sym.of_string $2 in + let maybe_type_sig = $3 in + let exp = $5 in + let pos = pos () in + Ast.VarDec + { name = var_id + ; escape = ref true + ; typ = maybe_type_sig + ; init = exp + ; pos + } } + ; - /* Fundec */ - | FUNCTION ID LPAREN RPAREN EQ exp - { - let id = $2 in - let exp = $6 in - sprintf "fundec[%s, arguments[], exp[%s]]" id exp - } - | FUNCTION ID LPAREN tyfields RPAREN EQ exp - { - let id = $2 in - let tyfields = $4 in - let exp = $7 in - sprintf "fundec[%s, arguments[%s], exp[%s]]" id tyfields exp - } - | FUNCTION ID LPAREN tyfields RPAREN COLON ID EQ exp +fun_decs: + | fun_dec { $1 :: [] } + | fun_dec fun_decs %prec LOWEST { $1 :: $2 } + ; + +fun_dec: + | FUNCTION ID LPAREN type_fields RPAREN maybe_type_sig EQ exp { - let id = $2 in - let tyfields = $4 in - let type_id = $7 in - let exp = $9 in - sprintf - "fundec[%s, tyfields[%s], type_id[%s], exp[%s]]" - id tyfields type_id exp + let name = Sym.of_string $2 in + let params = $4 in + let result = $6 in + let body = $8 in + let pos = pos () in + Ast.FunDec {name; params; result; body; pos} } ; -tyfields: +maybe_type_sig: + | { None } + | COLON ID { Some (Sym.of_string $2, pos ()) } + ; + +type_fields: + | + { [] } | ID COLON ID { - let id_1 = $1 in - let id_2 = $3 in - sprintf "%s : %s" id_1 id_2 - } - | ID COLON ID COMMA tyfields - { - let id_1 = $1 in - let id_2 = $3 in - let tyfield = sprintf "%s : %s" id_1 id_2 in - let tyfields = $5 in - sprintf "%s, %s" tyfield tyfields + let field = + Ast.Field + { name = Sym.of_string $1 + ; escape = ref true + ; typ = Sym.of_string $3 + ; pos = pos () + } + in + field :: [] + } + | ID COLON ID COMMA type_fields + { + let field = + Ast.Field + { name = Sym.of_string $1 + ; escape = ref true + ; typ = Sym.of_string $3 + ; pos = pos () + } + in + field :: $5 } ; fun_args: - | exp - { - $1 - } - | exp COMMA fun_args - { - sprintf "%s, %s" $1 $3 - } + | { [] } + | exp { $1 :: [] } + | exp COMMA fun_args { $1 :: $3 } ; lvalue: - | ID lvalue_part + | ID { - let id = $1 in - let part = $2 in - sprintf "lvalue[%s, part[%s]]" id part + Ast.SimpleVar + { symbol = Sym.of_string $1 + ; pos = pos () + } } - ; - -lvalue_part: - | {"epsilon[]"} - | lvalue_subscript {$1} - | lvalue_field_access {$1} - ; - -lvalue_subscript: - | LBRACK exp RBRACK + | lvalue LBRACK exp RBRACK { - let exp = $2 in - sprintf "subscript[%s]" exp + Ast.SubscriptVar + { var = $1 + ; exp = $3 + ; pos = pos () + } } - ; - -lvalue_field_access: - | DOT ID + | lvalue DOT ID { - let field = $2 in - sprintf "field_access[%s]" field + Ast.FieldVar + { var = $1 + ; symbol = Sym.of_string $3 + ; pos = pos () + } } ; diff --git a/tiger/src/lib/tiger/tiger_position.ml b/tiger/src/lib/tiger/tiger_position.ml new file mode 100644 index 0000000..01c230c --- /dev/null +++ b/tiger/src/lib/tiger/tiger_position.ml @@ -0,0 +1,21 @@ +type t = + { file : string + ; start_char : int + ; start_line : int + ; end_char : int + ; end_line : int + } + +let of_lexing_positions + ~pos_start: + Lexing.({pos_fname=sfile; pos_lnum=sline; pos_bol=sbol; pos_cnum=scnum}) + ~pos_end: + Lexing.({pos_fname=efile; pos_lnum=eline; pos_bol=ebol; pos_cnum=ecnum}) + = + assert (sfile = efile); + { file = sfile + ; start_char = scnum - sbol + ; start_line = sline + ; end_char = ecnum - ebol + ; end_line = eline + } diff --git a/tiger/src/lib/tiger/tiger_position.mli b/tiger/src/lib/tiger/tiger_position.mli new file mode 100644 index 0000000..dab4067 --- /dev/null +++ b/tiger/src/lib/tiger/tiger_position.mli @@ -0,0 +1,12 @@ +type t = + { file : string + ; start_char : int + ; start_line : int + ; end_char : int + ; end_line : int + } + +val of_lexing_positions + : pos_start:Lexing.position + -> pos_end:Lexing.position + -> t diff --git a/tiger/src/lib/tiger/tiger_symbol.ml b/tiger/src/lib/tiger/tiger_symbol.ml new file mode 100644 index 0000000..eb32942 --- /dev/null +++ b/tiger/src/lib/tiger/tiger_symbol.ml @@ -0,0 +1,23 @@ +module H = MoreLabels.Hashtbl + +type t = + { name : string + ; symbol : int + } + +let nextsym = ref 0 + +let symbols = H.create 16 + +let of_string name = + match H.find_opt symbols name with + | Some symbol -> + {name; symbol} + | None -> + incr nextsym; + let symbol = !nextsym in + H.replace symbols ~key:name ~data:symbol; + {name; symbol} + +let to_string {name; _} = + name diff --git a/tiger/src/lib/tiger/tiger_symbol.mli b/tiger/src/lib/tiger/tiger_symbol.mli new file mode 100644 index 0000000..8605047 --- /dev/null +++ b/tiger/src/lib/tiger/tiger_symbol.mli @@ -0,0 +1,5 @@ +type t + +val of_string : string -> t + +val to_string : t -> string -- 2.20.1