home / code / tiger.ml.git / blame
| Commit | Line | Data |
|---|---|---|
| 155ee327 SK |
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 | () |