36 |
|
|
37 |
(* check the well-formedness of a type and translate it to an AST type *) |
(* check the well-formedness of a type and translate it to an AST type *) |
38 |
fun checkTy (cxt, ty) = (case ty |
fun checkTy (cxt, ty) = (case ty |
39 |
of PT.T_Mark m => checkTy(cxt, #tree m) (* FIXME track context *) |
of PT.T_Mark m => checkTy(#span m, #tree m) |
40 |
| PT.T_Bool => Ty.T_Bool |
| PT.T_Bool => Ty.T_Bool |
41 |
| PT.T_Int => Ty.T_Int |
| PT.T_Int => Ty.T_Int |
42 |
| PT.T_Real => Ty.realTy |
| PT.T_Real => Ty.realTy |
57 |
| PT.T_Array(ty, dims) => raise Fail "Array type" |
| PT.T_Array(ty, dims) => raise Fail "Array type" |
58 |
(* end case *)) |
(* end case *)) |
59 |
|
|
60 |
|
fun checkLit lit = (case lit |
61 |
|
of (Literal.Int _) => (AST.E_Lit lit, Ty.T_Int) |
62 |
|
| (Literal.Float _) => (AST.E_Lit lit, Ty.realTy) |
63 |
|
| (Literal.String s) => (AST.E_Lit lit, Ty.T_String) |
64 |
|
| (Literal.Bool _) => (AST.E_Lit lit, Ty.T_Bool) |
65 |
|
(* end case *)) |
66 |
|
|
67 |
(* |
(* |
68 |
(* typecheck an expression and translate it to AST *) |
(* typecheck an expression and translate it to AST *) |
69 |
fun checkExpr (env, e) = (case e |
fun checkExpr (env, cxt, e) = (case e |
70 |
of PT.E_Mark of expr mark |
of PT.E_Mark m => checkExpr (env, #span m, #tree m) |
71 |
| PT.E_Var of var |
| PT.E_Var x => (case Env.findVar (env, x) |
72 |
| PT.E_Lit of Literal.literal |
of SOME x' => (case Var.typeOf x' |
73 |
|
of ([], ty) => (E_Var x', ty) |
74 |
|
| (tvs, ty) => raise Fail "unimplemented" |
75 |
|
(* end case *)) |
76 |
|
| NONE => raise Fail "undefined variable" |
77 |
|
(* end case *)) |
78 |
|
| PT.E_Lit lit => checkLit lit |
79 |
| PT.E_BinOp of expr * var * expr |
| PT.E_BinOp of expr * var * expr |
80 |
| PT.E_UnaryOp of var * expr |
| PT.E_UnaryOp of var * expr |
81 |
| PT.E_Tuple of expr list |
| PT.E_Tuple of expr list |
86 |
(* end case *)) |
(* end case *)) |
87 |
|
|
88 |
(* typecheck a statement and translate it to AST *) |
(* typecheck a statement and translate it to AST *) |
89 |
fun checkStmt (env, s) = (case s |
fun checkStmt (env, cxt, s) = (case s |
90 |
of PT.S_Mark of stmt mark |
of PT.S_Mark m => checkStmt (env, #span m, #tree m) |
91 |
| PT.S_Block of stmt list |
| PT.S_Block of stmt list |
92 |
| PT.S_Decl of var_decl |
| PT.S_Decl of var_decl |
93 |
| PT.S_IfThen of expr * stmt |
| PT.S_IfThen of expr * stmt |
98 |
| PT.S_Stabilize |
| PT.S_Stabilize |
99 |
(* end case *)) |
(* end case *)) |
100 |
|
|
101 |
fun checkDecl (env, d) = (case d |
fun checkDecl (env, cxt, d) = (case d |
102 |
of PT.D_Mark of decl mark |
of PT.D_Mark m => checkDecl (env, #span m, #tree m) |
103 |
| PT.D_Input of ty * var * expr option (* input variable decl with optional default *) |
| PT.D_Input(ty, x, optExp) = let |
104 |
|
val ty = checkTy(cxt, ty) |
105 |
|
val x' = Var.new(x, Var.InputVar, ty) |
106 |
|
val dcl = (case optExp |
107 |
|
of NONE => AST.D_Input(x', NONE) |
108 |
|
| SOME e => let |
109 |
|
val (e', ty') = checkExpr (env, cxt, e) |
110 |
|
in |
111 |
|
(* FIXME: check types *) |
112 |
|
AST.D_Input(x', SOME e') |
113 |
|
end |
114 |
|
(* end case *)) |
115 |
|
in |
116 |
|
(dcl, Env.insertGlobal(env, x, x')) |
117 |
|
end |
118 |
| PT.D_Var of var_decl (* global variable decl *) |
| PT.D_Var of var_decl (* global variable decl *) |
119 |
| PT.D_Actor of { (* actor decl *) |
| PT.D_Actor of { (* actor decl *) |
120 |
name : var, |
name : var, |
127 |
(* end case *)) |
(* end case *)) |
128 |
*) |
*) |
129 |
|
|
130 |
fun check (PT.Program dcls) = AST.Program() |
fun check (PT.Program dcls) = AST.Program[] |
131 |
|
|
132 |
end |
end |