Commits

Anonymous committed cb2b519

Allow the AST to carry an optional type annotation. Probably a temporary feature.

Comments (0)

Files changed (3)

     (* NOTE: this is just the AST that is generated by the parser *)
   type ast =
       Lit of sval
-    | Ref of string
+    | Ref of var
     | Cnd of ast * ast * ast
     | Seq of ast array
-    | Abs of string array * bool * ast (* params; varargs?; body *)
+    | Abs of var array * bool * ast (* params; varargs?; body *)
     | App of ast * ast array
-    | Let of (string * ast) array * ast * lettype 
+    | Let of (var * ast) array * ast * lettype 
     | Callcc of ast
-    | Set of string * ast
+    | Set of var * ast
+
+  and var = string * int
 
   type environment = variable StringMap.t
 
   type expr_or_def =
       Expr of ast
-    | Def of string * ast
+    | Def of var * ast
 
   let string_of_env env =
     StringMap.fold (fun k v acc -> k ^ " " ^ acc) env ""
     let rec convert (env:environment) (ast:ast) =
       match ast with
 	  Lit l -> A_lit l
-	| Ref r -> begin
+	| Ref (r, type_) -> begin
 	    try
 	      A_ref (StringMap.find r env)
 	    with Not_found ->
 	| Seq exprs -> A_seq (Array.map (convert env) exprs)
 
 	| Abs (params, varargs, body) -> 
-	    let params = Array.map mklocal params in
+	    let params = Array.map (fun (name, type_) -> mklocal name) params in
 	    let env = Array.fold_right 
 	      (fun var env -> StringMap.add var.var_name var env)
 	      params env
 
 	| Let (bindings, body, LT_letstar) ->
 	    let env, bindings = Array.fold_left
-	      (fun (env, bindings) (name, expr) ->
+	      (fun (env, bindings) ((name, type_), expr) ->
 		 let expr = convert env expr in
 		 let var = mklocal name in
 		 let env = StringMap.add var.var_name var env in
 
 	| Let (bindings, body, letrec) ->
 	    let bindings = Array.map 
-	      (fun (name, expr) -> (mklocal name, expr)) bindings in
+	      (fun ((name, type_), expr) -> (mklocal name, expr)) bindings in
 	    let locals = Array.map fst bindings in
 	    let env' = Array.fold_right
 	      (fun var env -> StringMap.add var.var_name var env)
 	    A_let (bindings, body, letrec)
 
 	| Callcc fn -> A_callcc (convert env fn)
-	| Set (name, expr) -> 
+	| Set ((name, type_), expr) -> 
 	    let r = StringMap.find name env in
 	    A_set (r, convert env expr)
     in
 open Printf
 open Blub_types
 open Blub_ast.Ast
+
+let mkvar name = (name, 33) ;;
 %}
 
 
 | assignment { $1 }
 | lambda { $1 }
 | letexpr { $1 }
-| LPAREN SHIFT variable expr RPAREN { App (Ref "control*", [| Abs ([|$3|], false, $4) |]) } 
-| LPAREN RESET expr RPAREN { App (Ref "prompt*", [| Abs ([||], false, $3) |] ) }
+| LPAREN SHIFT variable expr RPAREN { App (Ref (mkvar "control*"), 
+					   [| Abs ([|$3|], false, $4) |]) } 
+| LPAREN RESET expr RPAREN { App (Ref (mkvar "prompt*"), 
+				  [| Abs ([||], false, $3) |] ) }
 | LPAREN CALLCC expr RPAREN { Callcc $3 }  /* FIXME can I restrict it to variable or lambda? */
 | list { let hd :: tl = $1 in
 	 App (hd, Array.of_list tl) }	   
   LPAREN SET variable expr RPAREN { Set ($3, $4) }
 
 variable:
-  IDENTIFIER { $1 }
+  IDENTIFIER { mkvar $1 }
 ;
 
 cond:
       let expr = List.fold_left 
 	(fun alt (pred, cons, arrow) ->
 	   if arrow then
-	     let expr = Let( [| "fake", pred |],
-			     Cnd(Ref "fake", App (cons, [| Ref "fake" |]), alt),
+	     let fakevar = mkvar "fake" in
+	     let expr = Let( [| fakevar, pred |],
+			     Cnd(Ref fakevar, 
+				 App (cons, [| Ref fakevar |]), alt),
 			     LT_let) in
 	       expr
 	   else
   LPAREN LETREC bindings body RPAREN { Let (Array.of_list $3, $4, LT_letrec) }
 | LPAREN LET bindings body RPAREN { Let (Array.of_list $3, $4, LT_let) }
 | LPAREN LETSTAR bindings body RPAREN { Let (Array.of_list $3, $4, LT_letstar) }
-| LPAREN LET IDENTIFIER bindings body RPAREN 
+| LPAREN LET variable bindings body RPAREN 
       { let params = List.map fst $4 in
 	let args = List.map snd $4 in
 	Let ( [| $3, Abs (Array.of_list params, false, $5) |],
 ;
 
 inner_bindings:
-  inner_bindings LPAREN IDENTIFIER expr RPAREN { ($3, $4) :: $1 }
+  inner_bindings LPAREN variable expr RPAREN { ($3, $4) :: $1 }
 | { [] }
 ;
 

blub_primitives.ml

       let r, t = match e with
 	  Blub_ast.Ast.Expr expr ->
 	    eval_expr global_frame expr
-	| Blub_ast.Ast.Def (name, expr) ->
+	| Blub_ast.Ast.Def ((name, type_), expr) ->
 	    (* create a global variable for 'name' and eval the expression *)
 	    Blub_environment.Env.bind global_frame (Blub_common.mkglobal name) Sunbound;
-	    eval_expr global_frame (Blub_ast.Ast.Set (name, expr))
+	    eval_expr global_frame (Blub_ast.Ast.Set ((name, type_), expr))
       in
       if is_repl then 
 	printf "%a\n%f seconds\n%!" pp_sval r t;