joel/ast.ml at master · woodbridge/joel · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
(* Abstract Syntax Tree and functions for printing it *)

type op = Add | Sub | Mult | Div | Mod | Equal | Neq | Less | Leq | Greater | Geq |
          And | Or | Xor

type uop = Not | Neg

type pop = Inc | Dec

type typ = Num | String | Bool | List of typ | Table of typ list | Void

type bind = typ * string

type expr =
    IntegerLiteral of int
  | FloatLiteral of string
  | StringLiteral of string
  | BoolLiteral of bool
  | ListLiteral of expr list
  | TableLiteral of (expr list) list
  | ListAccess of expr * expr
  | TableAccess of expr * int
  | Length of expr
  | Id of string
  | In of string
  | Binop of expr * op * expr
  | Unop of uop * expr
  | Pop of string * pop
  | Assign of string * expr
  | AssignOp of string * op * expr
  | Call of string * expr list
  | Noexpr

type stmt =
    Block of stmt list
  | Expr of expr
  | Append of expr * expr
  | TableAppend of expr * expr list
  | Alter of expr * expr * expr
  | Out of expr
  | StmtVDecl of typ * string * expr
  | Return of expr
  | If of expr * stmt * stmt
  | For of expr * expr * expr * stmt
  | ForDecl of typ * string * expr * expr * expr * stmt
  | ForEach of typ * string * expr * stmt
  | While of expr * stmt

type func_decl = {
    typ : typ;
    fname : string;
    formals : bind list;
    body : stmt list;
  }

type program = func_decl list * stmt list


(* Pretty-printing functions *)

let string_of_op = function
    Add -> "+"
  | Sub -> "-"
  | Mult -> "*"
  | Div -> "/"
  | Mod -> "%"
  | Equal -> "=="
  | Neq -> "!="
  | Less -> "<"
  | Leq -> "<="
  | Greater -> ">"
  | Geq -> ">="
  | And -> "&"
  | Or -> "|"
  | Xor -> "^"

let string_of_uop = function
    Not -> "!"
  | Neg -> "-"

let string_of_pop = function
    Inc -> "++"
  | Dec -> "--"

let rec string_of_typ = function
    Num -> "num"
  | String -> "string"
  | Bool -> "bool"
  | List(t) -> "list: " ^ string_of_typ t
  | Table(lst) ->
      let concat_ocaml_string a b = a ^ (string_of_typ b) ^ " " in
      List.fold_left concat_ocaml_string "table " lst
  | Void -> "void"


let rec string_of_expr = function
    IntegerLiteral(l) -> string_of_int l
  | FloatLiteral(l) -> l
  | StringLiteral(l) -> "\"" ^ l ^ "\""
  | BoolLiteral(l) -> string_of_bool l
  | ListLiteral(_) -> "List"
  | ListAccess(_, _) -> "List Access"
  | TableAccess(_, _) -> "Table Access"
  | Length(_) -> "List Length"
  | In(_) -> "Table"
  | TableLiteral(rows) ->
    let string_of_row row =
      String.concat ", " (List.map string_of_expr (List.rev row))
        in
          "(" ^ String.concat ";\n" (List.map string_of_row rows) ^ ")\n"
  | Call(s, _) -> s ^ "()"
  | Id(s) -> s
  | Binop(e1, op, e2) -> string_of_expr e1 ^ " " ^ string_of_op op ^ " " ^ string_of_expr e2
  | Unop(uop, e) -> string_of_uop uop ^ string_of_expr e
  | Pop(s, pop) -> s ^ string_of_pop pop
  | Assign(v, e) -> v ^ " = " ^ string_of_expr e
  | AssignOp(v, op, e) -> v ^ " " ^ string_of_op op ^ "=" ^ " " ^ string_of_expr e
  | Noexpr -> ""

let rec string_of_stmt = function
    Expr(expr) -> string_of_expr expr ^ ";\n";
  | Block(l) -> String.concat "\n" (List.map string_of_stmt l) ^ "\n"
  | StmtVDecl(t, n, e) -> string_of_typ t ^ " " ^ n ^ " = " ^ string_of_expr e ^ ";"
  | Return(e) -> "return " ^ string_of_expr e
  | If(e, s1, s2) -> "if (" ^ string_of_expr e ^ ") {\n" ^ string_of_stmt s1 ^ "\n} else  {\n" ^ string_of_stmt s2 ^ "}\n"
  | For(e1, e2, e3, s) -> "for (" ^ string_of_expr e1 ^ "; " ^ string_of_expr e2 ^ "; " ^ string_of_expr e3 ^ ") {\n" ^ string_of_stmt s ^ "}\n"
  | _ -> "pretty-print not implemented\n"

let string_of_fdecl func = string_of_typ func.typ ^ " " ^ func.fname ^ " "

let string_of_program (funcs, stmts) =
  String.concat "" (List.map string_of_fdecl funcs) ^ "\n" ^
  String.concat "\n" (List.map string_of_stmt (List.rev stmts))