| 1 | module A = Tiger_absyn |
| 2 | module Env = Tiger_env |
| 3 | module E = Tiger_error |
| 4 | module Map = Tiger_map |
| 5 | module Pos = Tiger_position |
| 6 | module Symbol = Tiger_symbol |
| 7 | module Translate = Tiger_translate |
| 8 | module Type = Tiger_env_type |
| 9 | module Value = Tiger_env_value |
| 10 | |
| 11 | (* The only reason for having this seemingly-superfluous inner module is to |
| 12 | * have this nice signature as a summary of what each function does. *) |
| 13 | module Semant : sig |
| 14 | type expty = |
| 15 | { exp : Translate.exp |
| 16 | ; ty : Type.t |
| 17 | } |
| 18 | |
| 19 | (* Violating normal naming convention just to make it easier to follow |
| 20 | * Appel's |
| 21 | *) |
| 22 | val transExp : env:Env.t -> A.exp -> expty |
| 23 | val transVar : env:Env.t -> A.var -> expty |
| 24 | val transDec : env:Env.t -> A.dec -> Env.t |
| 25 | val transTy : env:Env.t -> A.ty -> Type.t (* needs only type env *) |
| 26 | end = struct |
| 27 | type expty = |
| 28 | { exp : Translate.exp |
| 29 | ; ty : Type.t |
| 30 | } |
| 31 | |
| 32 | let unimplemented () = |
| 33 | failwith "unimplemented" |
| 34 | |
| 35 | (* TODO: Perhaps a wrapper for env.get that raises semantic error if not found *) |
| 36 | |
| 37 | let transExp ~env:_ exp = |
| 38 | (match exp with |
| 39 | | A.NilExp -> |
| 40 | unimplemented () |
| 41 | | A.IntExp _ -> |
| 42 | unimplemented () |
| 43 | | A.StringExp {string=_; _} -> |
| 44 | unimplemented () |
| 45 | | A.CallExp {func=_; args=_; pos=_} -> |
| 46 | unimplemented () |
| 47 | | A.OpExp {left=_; oper=_; right=_; pos=_} -> |
| 48 | unimplemented () |
| 49 | | A.RecordExp {fields=_; typ=_; pos=_} -> |
| 50 | unimplemented () |
| 51 | | A.SeqExp _ -> |
| 52 | unimplemented () |
| 53 | | A.AssignExp {var=_; exp=_; _} -> |
| 54 | unimplemented () |
| 55 | | A.IfExp {test=_; then'=_; else'=_; _} -> |
| 56 | unimplemented () |
| 57 | | A.WhileExp {test=_; body=_; _} -> |
| 58 | unimplemented () |
| 59 | | A.ForExp {var=_; lo=_; hi=_; body=_; _} -> |
| 60 | unimplemented () |
| 61 | | A.BreakExp _ -> |
| 62 | unimplemented () |
| 63 | | A.LetExp {decs=_; body=_; _} -> |
| 64 | unimplemented () |
| 65 | | A.ArrayExp {typ=_; size=_; init=_; _} -> |
| 66 | unimplemented () |
| 67 | | A.VarExp _ -> |
| 68 | unimplemented () |
| 69 | ) |
| 70 | |
| 71 | let transVar ~env:_ var = |
| 72 | (match var with |
| 73 | | A.SimpleVar {symbol=_; _} -> |
| 74 | unimplemented () |
| 75 | | A.FieldVar {var=_; symbol=_; _} -> |
| 76 | unimplemented () |
| 77 | | A.SubscriptVar {var=_; exp=_; _} -> |
| 78 | unimplemented () |
| 79 | ) |
| 80 | |
| 81 | let transDec ~env:_ dec = |
| 82 | (match dec with |
| 83 | | A.VarDec {name=_; typ=_; init=_; pos=_; escape=_} -> |
| 84 | unimplemented () |
| 85 | | A.TypeDecs _ -> |
| 86 | unimplemented () |
| 87 | | A.FunDecs _ -> |
| 88 | unimplemented () |
| 89 | ) |
| 90 | |
| 91 | let transTy ~env:_ typ = |
| 92 | (match typ with |
| 93 | | A.NameTy {symbol = _; pos = _} -> |
| 94 | unimplemented () |
| 95 | | A.RecordTy _ -> |
| 96 | unimplemented () |
| 97 | | A.ArrayTy {symbol = _; pos = _} -> |
| 98 | unimplemented () |
| 99 | ) |
| 100 | end |
| 101 | |
| 102 | let transProg absyn = |
| 103 | let open Semant in |
| 104 | let {exp = _; ty = _} = transExp absyn ~env:Env.base in |
| 105 | () |