Commits

Sid Asnani committed 942aaac

adding basic files

Comments (0)

Files changed (3)

+#use "scheme.ml";;
+#use "testUtils.ml";;
+
+let rec unparse_list2 = function
+    [] -> ""
+  | (x::[]) -> unparse2 x
+  | (x::xs) -> (unparse2 x) ^ ";" ^ (unparse_list2 xs)
+
+and unparse2 = function
+  | Id id -> "(Id \"" ^ id ^ "\")"
+  | Num n -> "(Num " ^ string_of_int n ^ ")"
+  | Bool true -> "(Bool true)"
+  | Bool false -> "(Bool false)"
+  | String s -> "(String \"" ^ s ^ "\")"
+  | List l -> "(List [" ^ unparse_list2 l ^ "])"
+;;
+
+let test_parse x = List.map (fun y -> 
+	print_endline ("% " ^ y) ;
+	print_endline (unparse2 (parse (tokenize y))))
+	x
+;;
+let test_eval x = List.map (fun y -> 
+	print_endline ("% " ^ (unparse y));
+	print_endline (string_of_value (eval y))) x
+;;
+
+(* Your test cases here *)
+(*
+test_parse [ "(1 (2 (3 ( 4 ( 5 ) ) ) 6) )" ] ;;
+*)
+test_eval [ (List [(Id "define");(Id "x");(Num 2)]) ; ] ;;
+test_eval [Id "nil"] ;;
+test_eval [Id "x"] ;;
+test_eval [ (List [(List [(Id "lambda");List[(Id "x")];List [(Id "+");(Id "x");(Num 2)]]); (Num 2)])] ;;
+
+test_eval [(List [(Id "define");(Id "x");(Num 52)]) ;
+	(List [(Id "define");(Id "foo");
+		(List [(Id "lambda");
+		(List [(Id "x")]);
+		(List [(Id "lambda");
+		(List [(Id "y")]);
+		(List [(Id "+");(Id "x");(Id "y")])])])]) ;
+	(List [(List [(Id "foo");(Num 3)]);(Num 4)]) ;
+	(List [(Id "define");(Id "bar");
+		(List [(Id "lambda");
+		(List [(Id "y")]);
+		(List [(Id "+");(Id "x");(Id "y")])])]) ;
+	(List [(Id "bar");(Num 2)]) ;
+	(List [(Id "define");(Id "x");(Num 7)]) ;
+	(List [(Id "bar");(Num 2)]) ] ;;
+
+test_eval [(List [(Id "define");(Id "nested");
+		(List [(Id "lambda");
+		(List [(Id "x")]);
+		(List [(Id "lambda");
+		(List [(Id "x")]);
+		(List [(Id "+");(Id "x");(Id "x")])])])])];;
+
+test_eval [(List[(List[(Id "nested");(Num 1)]);(Num 3)])]
+
+#load "str.cma"
+
+(* abstract syntax tree *)
+type ast =
+    Id of string
+  | Num of int
+  | Bool of bool
+  | String of string
+  | List of ast list
+
+(* An unparser turns an AST back into a string.*)
+let rec unparse_list = function
+    [] -> ""
+  | (x::[]) -> unparse x
+  | (x::xs) -> (unparse x) ^ " " ^ (unparse_list xs)
+
+and unparse = function
+  | Id id -> id
+  | Num n -> string_of_int n
+  | Bool true -> "#t"
+  | Bool false -> "#f"
+  | String s -> "\"" ^ s ^ "\""
+  | List l -> "(" ^ unparse_list l ^ ")"
+
+(************************************************************************)
+
+(* Lexing *)
+
+type token =
+   TId of string
+ | TNum of int
+ | TString of string
+ | TTrue
+ | TFalse
+ | TLParen
+ | TRParen
+
+let re_lparen = Str.regexp "("
+let re_rparen = Str.regexp ")"
+let re_id = Str.regexp "[a-zA-Z=*+/<>!?-][a-zA-Z0-9=*+/<>!?-]*"
+let re_num = Str.regexp "[-]*[0-9]+"
+let re_true = Str.regexp "#t"
+let re_false = Str.regexp "#f"
+let re_string = Str.regexp "\"[^\"]*\""
+let re_whitespace = Str.regexp "[ \t\n]"
+
+exception Lex_error of int
+
+let tokenize s =
+ let rec tokenize' pos s =
+   if pos >= String.length s then
+     []
+   else begin
+     if (Str.string_match re_lparen s pos) then
+       TLParen::(tokenize' (pos+1) s)
+     else if (Str.string_match re_rparen s pos) then
+       TRParen::(tokenize' (pos+1) s)
+     else if (Str.string_match re_true s pos) then
+       TTrue::(tokenize' (pos+2) s)
+     else if (Str.string_match re_false s pos) then
+       TFalse::(tokenize' (pos+2) s)
+     else if (Str.string_match re_id s pos) then
+       let token = Str.matched_string s in
+       let new_pos = Str.match_end () in
+       (TId token)::(tokenize' new_pos s)
+     else if (Str.string_match re_string s pos) then
+       let token = Str.matched_string s in
+       let new_pos = Str.match_end () in
+       let tok = TString (String.sub token 1 ((String.length token)-2)) in
+       tok::(tokenize' new_pos s)
+     else if (Str.string_match re_num s pos) then
+       let token = Str.matched_string s in
+       let new_pos = Str.match_end () in
+       (TNum (int_of_string token))::(tokenize' new_pos s)
+     else if (Str.string_match re_whitespace s pos) then
+       tokenize' (Str.match_end ()) s
+     else
+       raise (Lex_error pos)
+   end
+ in
+ tokenize' 0 s
+
+(************************************************************************)
+
+let after = ref []
+
+
+ let rec parse_list l = match l with
+   h::[] -> parse_sexpr h
+ | TLParen::t-> List (parse_sexpr_list t)
+
+  and parse_sexpr_list l = match l with
+    [] -> []
+  | TRParen::t -> after.contents <- t ; []
+  | h::TRParen::[] -> after.contents <- []; [parse_sexpr h]
+  | h::TRParen::t -> after.contents <- t; [parse_sexpr h]
+  | TLParen::t -> let b = (parse_list l) in b::(parse_sexpr_list !after)
+  | h::t -> (parse_sexpr h)::(parse_sexpr_list t)
+
+  and parse_sexpr h = match h with
+   TId s -> Id s
+ | TNum i -> Num i
+ | TString s -> String s
+ | TTrue -> Bool true
+ | TFalse -> Bool false
+
+let parse l = parse_list l  
+
+
+
+type value =
+    Val_Num of int
+  | Val_Bool of bool
+  | Val_String of string
+  | Val_Nil
+  | Val_Cons of value * value
+  | Val_Func of string * ast * environment
+
+and
+environment = (string * value) list
+
+exception Unbounded of string * environment * ast
+
+
+let rec string_of_value = function
+    Val_Num n -> string_of_int n
+  | Val_Bool true -> "#t"
+  | Val_Bool false -> "#f"
+  | Val_String s -> "\"" ^ s ^ "\""
+  | Val_Nil -> "nil"
+  | Val_Cons (v1, v2) -> "(cons " ^ (string_of_value v1) ^ " " ^
+      (string_of_value v2) ^ ")"
+  | Val_Func (s,ast2,envi) -> raise (Unbounded (s,envi,ast2))
+
+
+let e = ref [("nil",Val_Nil)]
+
+let rec eval_h ast1 envi = (* print_endline ("Eval: " ^ (unparse ast1)); *)match ast1 with
+    Num i -> Val_Num i
+  | Bool b ->  Val_Bool b
+  | String s -> Val_String s
+  | Id s -> if List.exists (fun (q,_) -> q = s) envi then
+        (match List.find (fun (q,_) -> q = s) envi with
+            (q,t) -> t)
+        else (if List.exists (fun (q,_) -> q = s) !e then
+        (match List.find (fun (q,_) -> q = s) !e with
+            (q,t) -> t)
+        else raise (Unbounded (s,!e, ast1)))
+  | List ast2 -> eval_list ast2 envi
+  (* | List ast2 -> (let b = eval_list ast2 envi in match b with Val_Func (v2,ast5,envi4) -> if List.exists (fun (q,_) -> q = v2) envi4 then (eval_h ast5 envi4) else b | _ -> b) *)
+  
+
+and eval_list ast2 envi = (* print_endline ("List: "^(unparse (List ast2))); *)
+    match ast2 with
+    h1::t1::tr -> (match h1 with
+        Id "+" -> Val_Num (sum (t1::tr) envi)
+      | Id "-" -> (match tr with
+                    [] -> (match (eval_h t1 envi) with Val_Num i -> Val_Num(-1*i))
+                  | _ -> (match (eval_h t1 envi) with Val_Num i -> Val_Num(i - (sum tr envi))))
+      | Id "*" -> (match tr with
+                    [] -> (eval_h t1 envi)
+                  | hs::ts -> (match ((eval_h t1 envi),(eval_h hs envi)) with (Val_Num i,Val_Num j) ->  eval_list (Id "*"::(Num (i * j)::ts)) envi))
+      | Id "=" -> (match tr with t2::_ ->
+                    match ((eval_h t1 envi),(eval_h t2 envi)) with
+                     (Val_Num i,Val_Num j) -> Val_Bool (i=j)
+                    | _ -> Val_Bool false)
+      | Id "if" -> (match (eval_h t1 envi) with Val_Bool true -> (match tr with hs::_ -> (eval_h hs envi)) | Val_Bool false -> (match tr with hs::[] -> Val_Nil | hs::ts::[] -> (eval_h ts envi)))
+      | Id "define" -> (match (t1,tr) with (Id s,t2::_) -> e.contents <- (s,(eval_h t2 envi))::(List.remove_assoc s !e)); Val_Nil
+      | Id "lambda" -> (match t1 with List ([Id s]) -> match tr with ts::_ -> Val_Func (s,ts,envi))
+      | Id "cons" -> (match tr with t2::[] -> Val_Cons ((eval_h t1 envi),(eval_h t2 envi)))
+      | Id "car" -> (match (eval_h t1 envi) with Val_Cons (x,y) -> x)
+      | Id "cdr" -> (match (eval_h t1 envi) with Val_Cons (x,y) -> y)
+      | Id "boolean?" -> (match (eval_h t1 envi) with Val_Bool b -> Val_Bool true | _ -> Val_Bool false)
+      | Id "number?" -> (match (eval_h t1 envi) with Val_Num i -> Val_Bool true | _ -> Val_Bool false)
+      | Id "string?" -> (match (eval_h t1 envi) with Val_String s -> Val_Bool true | _ -> Val_Bool false)
+      | Id "pair?" -> (match (eval_h t1 envi) with Val_Cons (c,d) -> Val_Bool true | _ -> Val_Bool false)
+      | Id "display" -> (match (eval_h t1 envi) with (Val_String s) -> (print_string s; Val_Nil))
+      | Id s -> (if List.exists (fun (q,_) -> q = s) !e then
+            (match List.find (fun (q,_) -> q = s) !e with
+                (q1,c1) -> (match c1 with
+                    (Val_Func (v1,ast3,envi2)) -> let d = (eval_h t1 envi) in (eval_h (eval_func c1 t1) ((v1,d)::envi2))
+            ))
+            else raise (Unbounded ("list",!e,h1)) )
+      (* | List ast4 -> (let b = eval_list ast4 envi in match b with Val_Func (v,ast5,envi4) -> Val_Func (v, ast5, ((v,eval_h t1 envi)::envi4)) | _ -> b) *)
+      | List ast4 -> (let b = eval_list ast4 envi in match b with Val_Func (v,ast5,envi4) -> let c = (eval_func b t1) in eval_h c envi | _ -> b)
+)
+
+and sum lst envi = match lst with
+    h::[] -> (match (eval_h h envi) with Val_Num i -> i)
+  | h::t -> (match (eval_h h envi) with Val_Num i -> (i + sum t envi))
+
+and eval_func valf param = match valf with
+    Val_Func (s,ast4,envi) -> let b = replace ast4 s param in (* print_endline ("Func_end: " ^ (unparse b)); *) b
+
+and replace ast1 var param = 
+    match ast1 with
+    Id s -> if var = s then param else Id s
+  | List ast2 -> List (replace_list ast2 var param)
+  | _ ->  ast1
+
+and replace_list ast_lst var param = match ast_lst with
+   [] -> []
+ | h::[] -> (replace h var param)::[]
+ | Id "lambda"::List ([Id s])::(List ast3)::_ -> if var = s then ast_lst else (Id "lambda")::((List ([Id s]))::[(List (replace_list ast3 var param))])
+ | h::t -> (replace h var param)::(replace_list t var param)
+
+let eval ast1 = eval_h ast1 []
+
+(* --------------------------------- *)
+(* int *)
+
+let prt_int x = print_endline (string_of_int x)
+;;
+
+(* --------------------------------- *)
+(* int list *)
+
+let string_of_int_list l =
+    let rec string_of_int_elements l = match l with
+          [] -> ""
+        | (h::[]) -> string_of_int h
+        | (h::t) -> string_of_int h ^ ";" ^ string_of_int_elements t
+    in "[" ^ string_of_int_elements l ^ "]"
+;;
+
+let prt_int_list l = print_endline (string_of_int_list l)
+;;
+
+(* --------------------------------- *)
+(* int list list *)
+
+let rec string_of_int_list_list l = match l with
+      [] -> ""
+    | (h::t) -> (string_of_int_list h) ^ (string_of_int_list_list t)
+;;
+
+let prt_int_list_list l = print_endline (string_of_int_list_list l)
+;;
+
+(* --------------------------------- *)
+(* bool *)
+
+let prt_bool x = print_endline (string_of_bool x)
+;;
+
+(* --------------------------------- *)
+(* bool list *)
+
+let string_of_bool_list l =
+    let rec string_of_bool_elements l = match l with
+          [] -> ""
+        | (h::[]) -> string_of_bool h
+        | (h::t) -> string_of_bool h ^ ";" ^ string_of_bool_elements t
+    in "[" ^ string_of_bool_elements l ^ "]"
+;;
+
+let prt_bool_list l = print_endline (string_of_bool_list l)
+;;
+
+(* --------------------------------- *)
+(* int tuple *)
+
+let string_of_int_tuple_list (a,b) =
+  "(" ^ string_of_int_list a ^ ", " ^ string_of_int_list b ^ ")"
+;;
+
+let prt_int_tuple_list (a,b) = print_endline (string_of_int_tuple_list (a,b))
+;;
+
+(* --------------------------------- *)
+(* char *)
+
+let rec string_of_char_list = function
+      [] -> ""
+    | (h::t) -> (Char.escaped h) ^ " " ^ (string_of_char_list t)
+;;
+
+let prt_char_list x = print_endline (string_of_char_list x)
+;;
+
+let prt_char_list_sorted x = print_endline 
+	(string_of_char_list (List.sort Char.compare x))
+;;
+
+(* --------------------------------- *)
+(* string list *)
+
+let string_of_str_list l =
+    let rec string_of_str_elements l = match l with
+          [] -> ""
+        | (h::[]) -> h
+        | (h::t) -> h ^ ";" ^ string_of_str_elements t
+    in "[" ^ string_of_str_elements l ^ "]"
+;;
+
+let prt_str_list l = print_endline (string_of_str_list l)
+;;
+
+
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.