Commits

Anonymous committed b662a2b Merge

Resolved some horrible merge problems that I brought on myself.

Comments (0)

Files changed (11)

 LINKFLAGS=-linkpkg
 OCAMLOPTFLAGS=
 
-SRC_FILES := blub_types.mli blub_error.ml blub_misc.ml blub_common.ml blub_ast.ml blub_environment.ml blub_typecheck.ml blub_closure.ml blub_llvm.ml blub_vm.ml blub_list.ml blub_parse.mly blub_vector.ml blub_num.ml blub_string.ml blub_lexer.mll blub_primitives.ml blub_interp.ml
+SRC_FILES := blub_types.mli blub_error.ml blub_misc.ml blub_common.ml blub_typecheck.ml blub_ast.ml blub_environment.ml blub_closure.ml blub_llvm.ml blub_vm.ml blub_list.ml blub_parse.mly blub_vector.ml blub_num.ml blub_string.ml blub_lexer.mll blub_primitives.ml blub_interp.ml
 ML_FILES  := $(filter %.ml,$(patsubst %.mll,%.ml,$(SRC_FILES:%.mly=%.ml)))
 MLI_FILES := $(filter %.mli,$(SRC_FILES:%.mly=%.mli))
 CMX_FILES := $(ML_FILES:%.ml=%.cmx) 
     (* 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
 
   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 ""
 	  Lit l -> A_lit l
 	| Ref r -> begin
 	    try
-	      A_ref (StringMap.find r env)
+	      let var = StringMap.find r env in
+	      A_ref var
 	    with Not_found ->
 	      A_ref (mkglobal r)
 	  end
 
 	| Let (bindings, body, letrec) ->
 	    let bindings = Array.map 
-	      (fun (name, expr) -> (mklocal name, expr)) bindings in
+	      (fun (name, 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_set _ -> assert false
   in
   let free_vars = find ast in
-  printf "FREE VARS: %a\n%!" (pp_set pp_var) free_vars;
   free_vars
 ;;
 

File contents unchanged.

blub_environment.ml

 open Printf
 open Blub_types
+open Blub_common
 open Blub_ast
 
 
   ;;
 
 
+  let mkglobal name = Blub_common.mkglobal name ;;
+
   let set_pfn env fn name =
-    bind env (Blub_common.mkglobal name) (Spfn fn)
+    bind env (mkglobal name) (Spfn fn)
   ;;
 
   let set_pf0 env fn name =
     let wrapper = function
 	[|  |] -> fn ()
     in
-    bind env (Blub_common.mkglobal name) (Spfn wrapper)
+    bind env (mkglobal name) (Spfn wrapper)
   ;;
   let set_pf1 env fn name =
     let wrapper = function
 	[| arg |] -> fn arg
     in
-    bind env (Blub_common.mkglobal name) (Spfn wrapper)
+    bind env (mkglobal name) (Spfn wrapper)
   ;;
 
   let set_pf2 env fn name =
     let wrapper = function
 	[| arg1; arg2 |] -> fn arg1 arg2
     in
-    bind env (Blub_common.mkglobal name) (Spfn wrapper)
+    bind env (mkglobal name) (Spfn wrapper)
   ;;
 
   let set_pf3 env fn name =
     let wrapper = function
 	[| arg1; arg2; arg3 |] -> fn arg1 arg2 arg3
     in
-    bind env (Blub_common.mkglobal name) (Spfn wrapper)
+    bind env (mkglobal name) (Spfn wrapper)
   ;;
 
   let set_pfe env fn name =
-    bind env (Blub_common.mkglobal name) (Spfe fn)
+    bind env (mkglobal name) (Spfe fn)
   ;;
 
 
 {
   open Blub_parse
+  open Blub_types
 }
 
 let digit = ['0' - '9']
 	let s = Buffer.contents buf in
 	STRING s
       }
-
   | (initial subsequent*) | peculiar_id as id { IDENTIFIER id }
       
 
     [| |] -> Sint 0
   | [| x |] -> x
   | [| Sint x; Sint y |] -> Sint (x+y)
+  | [| Sfloat x; Sfloat y |] -> Sfloat (x +. y)
+  | [| Sint x; Sfloat y |] -> Sfloat (float x +. y)
+  | [| Sfloat x; Sint y |] -> Sfloat (float y +. x)
   | ints ->
       let ints = Array.map (fun (Sint x) -> x) ints in
       Sint (Array.fold_right (+) ints 0)
 ;;
 
+let add1 = function
+    Sint x -> Sint (x+1)
+;;
+
 let subn = function
     [| Sint x |] -> Sint (-x)
   | [| Sint x; Sint y |] -> Sint (x-y)
       Sint (Array.fold_left (-) (2 * ints.(0)) ints)
 ;;
 
+let muln = function
+    [| |] -> Sint 1
+  | [| x |] -> x
+  | [| Sint x; Sint y |] -> Sint (x*y)
+  | [| Sint x; Sfloat y |] -> Sfloat ((float x) *. y)
+  | [| Sfloat x; Sfloat y |] -> Sfloat (x *. y)
+  | [| Sfloat x; Sint y |] -> Sfloat (x *. (float y))
+;;
+
+let divn = function
+    [| |] -> Sint 1
+  | [| x |] -> x
+  | [| Sint x; Sint y |] -> Sint (x/y)
+  | [| Sint x; Sfloat y |] -> Sfloat ((float x) /. y)
+  | [| Sfloat x; Sfloat y |] -> Sfloat (x /. y)
+  | [| Sfloat x; Sint y |] -> Sfloat (x /. (float y))
+;;
+
+
+
 let cmp2 eq_only a b =
   match (a, b) with
       (Sint i1, Sint i2) ->
 	if i1 > i2 then 1 else if i1 < i2 then -1 else 0
+    | (Sfloat i1, Sfloat i2) ->
+	if i1 > i2 then 1 else if i1 < i2 then -1 else 0
     | _ ->
 	printf "Invalid args: %a and %a\n%!" pp_sval a pp_sval b;
 	assert false
 
 let init e =
   set_pfn e addn "+";
+  set_pf1 e add1 "add1";
   set_pfn e subn "-";
+  set_pfn e muln "*";
+  set_pfn e divn "/";
   set_pfn e snum_eq "=";
 
   set_pfn e (snum_rel (>)) ">";
 open Printf
 open Blub_types
 open Blub_ast.Ast
+open Blub_common
+
+let mkvar name = name ;;
 %}
 
 
 | 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 }
 | { [] }
 ;
 

File contents unchanged.

blub_typecheck.ml

 	    printf "Variable %a not found in environment\n%!" pp_var var;
 	    raise (Tcheck_failed "")
 	end
+
       | A_cnd (e1, e2, e3) ->
 	  let t2 = tcheck r e2 in
 	  let t3 = tcheck r e3 in
 	  tcheck env e2
 *)
 
-      | A_let _ | A_set _ | A_callcc _ ->
+      | A_let _ | A_set _ | A_callcc _ | A_abs _ ->
 	  printf "sorry, Shawn is lazy and hasn't got this stuff working again yet!!";
 	  raise (Tcheck_failed "")
 (*

File contents unchanged.

Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.