Tip of the day
News
Instructions
Objective
Write a Ocaml assignment program to create a very simple interpreter.
Requirements and Specifications
interpreter.ml which contains a function, interpreter, with the following type signature:
interp : string -> string list
The function will take a program as an input string, and will return a list of strings "logged" by the program. A stack is used internally to keep track of intermediate evaluation results. Only the string log will be tested during grading, the stack will not be tested.
3.3 Commands
Your interpreter should be able to handle the following commands:
Push
All kinds of const are pushed to the stack in the same way. Resolve the constant to the appropriate value and add it to the stack.
Pop
The command Pop n removes the top n values from the stack. If n is negative or the stack contains less than n values, terminate evaluation with error.
Trace
The Trace n command consumes the top n values on the stack and adds their string representations to the output list. New entries to the log should be added to the head position. If n is negative or the stack contains less than n values, terminate with error. For a Trace n command where n > 1, the produced log should be equivalent to n executions of Trace 1 command.
Sub
Sub n consumes the top n values on the stack, and pushes the difference between the top value and the sum of next n − 1 values to the stack. If n is negative or there are fewer than n values on the stack, terminate with error. If the top n values on the stack are not integers, terminate with error. If n is zero, push 0 onto the stack without consuming anything on the stack.
Mul
Mul n consumes the top n values in the stack, and pushes their product to the stack. If n is negative or there are fewer than n values on the stack, terminate with error. If the top n values on the stack are not integers, terminate with error. If n is zero, push 1 onto the stack without consuming anything on the stack.
Div
Div n consumes the top n values on the stack, and pushes the quotient between the top value and the product of the next n − 1 values to the stack. If n is negative or there are fewer than n values on the stack, terminate with error. If the product of the next n − 1 values are 0, terminate with error. If the top n values on the stack are not integers, terminate with error. If n is zero, push 1 onto the stack without consuming anything on the stack.
Screenshots of output
Source Code
(* parsing util functions *)let is_lower_case c = 'a' <= c && c <= 'z'let is_upper_case c = 'A' <= c && c <= 'Z'let is_alpha c = is_lower_case c || is_upper_case clet is_digit c = '0' <= c && c <= '9' let is_alphanum c = is_lower_case c || is_upper_case c || is_digit clet is_blank c = String.contains " \012\n\r\t" clet explode s = List.of_seq (String.to_seq s)let implode ls = String.of_seq (List.to_seq ls)let readlines (file : string) : string = let fp = open_in file in let rec loop () = match input_line fp with | s -> s ^ "\n" ^ loop () | exception End_of_file -> "" in let res = loop () in let () = close_in fp in res(* end of util functions *)(* parser combinators *)type 'a parser = char list -> ('a * char list) optionlet parse (p : 'a parser) (s : string) : ('a * char list) option = p (explode s)let pure (x : 'a) : 'a parser = fun ls -> Some (x, ls)let fail : 'a parser = fun ls -> Nonelet bind (p : 'a parser) (q : 'a -> 'b parser) : 'b parser = fun ls -> match p ls with | Some (a, ls) -> q a ls | None -> Nonelet ( >>= ) = bind let ( let* ) = bind let read : char parser = fun ls -> match ls with | x :: ls -> Some (x, ls) | _ -> Nonelet satisfy (f : char -> bool) : char parser = fun ls -> match ls with | x :: ls -> if f x then Some (x, ls) else None | _ -> Nonelet char (c : char) : char parser = satisfy (fun x -> x = c)let seq (p1 : 'a parser) (p2 : 'b parser) : 'b parser = fun ls -> match p1 ls with | Some (_, ls) -> p2 ls | None -> Nonelet ( >> ) = seqlet seq' (p1 : 'a parser) (p2 : 'b parser) : 'a parser = fun ls -> match p1 ls with | Some (x, ls) -> ( match p2 ls with | Some (_, ls) -> Some (x, ls) | None -> None) | None -> Nonelet ( << ) = seq'let alt (p1 : 'a parser) (p2 : 'a parser) : 'a parser = fun ls -> match p1 ls with | Some (x, ls) -> Some (x, ls) | None -> p2 lslet ( <|> ) = altlet map (p : 'a parser) (f : 'a -> 'b) : 'b parser = fun ls -> match p ls with | Some (a, ls) -> Some (f a, ls) | None -> Nonelet ( >|= ) = map let ( >| ) p c = map p (fun _ -> c) let rec many (p : 'a parser) : 'a list parser = fun ls -> match p ls with | Some (x, ls) -> ( match many p ls with | Some (xs, ls) -> Some (x :: xs, ls) | None -> Some ([ x ], ls)) | None -> Some ([], ls)let rec many1 (p : 'a parser) : 'a list parser = fun ls -> match p ls with | Some (x, ls) -> ( match many p ls with | Some (xs, ls) -> Some (x :: xs, ls) | None -> Some ([ x ], ls)) | None -> Nonelet rec many' (p : unit -> 'a parser) : 'a list parser = fun ls -> match p () ls with | Some (x, ls) -> ( match many' p ls with | Some (xs, ls) -> Some (x :: xs, ls) | None -> Some ([ x ], ls)) | None -> Some ([], ls)let rec many1' (p : unit -> 'a parser) : 'a list parser = fun ls -> match p () ls with | Some (x, ls) -> ( match many' p ls with | Some (xs, ls) -> Some (x :: xs, ls) | None -> Some ([ x ], ls)) | None -> Nonelet whitespace : unit parser = fun ls -> match ls with | c :: ls -> if String.contains " \012\n\r\t" c then Some ((), ls) else None | _ -> Nonelet ws : unit parser = many whitespace >| ()let ws1 : unit parser = many1 whitespace >| ()let digit : char parser = satisfy is_digitlet natural : int parser = fun ls -> match many1 digit ls with | Some (xs, ls) -> Some (int_of_string (implode xs), ls) | _ -> Nonelet literal (s : string) : unit parser = fun ls -> let cs = explode s in let rec loop cs ls = match (cs, ls) with | [], _ -> Some ((), ls) | c :: cs, x :: xs -> if x = c then loop cs xs else None | _ -> None in loop cs lslet keyword (s : string) : unit parser = literal s >> ws >| ()let letter : char parser = satisfy is_alpha(* end of parser combinators *)(***************** Interpreter implementation *****************)(* Define a dictionary to handle environments *)module Dict = Map.Make(String)(* Type for the supported values int, bool, () and name *)type value = Int of int | Bool of bool | Unit | Name of string(* Type for the supported commands and their arguments *)type command = Push of value | Pop of int | Trace of int | Add of int | Sub of int | Mul of int | Div of int | And | Or | Not | Equal | Lte | Local | Global | Lookup | BeginEnd of command list | IfElseEnd of command list * command list(* Type for the output *)type output = string list(* Type for the environment *)type environment = value Dict.t(* Type for the current state *)type state = { stack : value list; out : output; local : environment; global : environment}let empty_state : state = { stack = []; out = []; local = Dict.empty; global = Dict.empty }(* Parse an integer *)let parse_int : value parser = ((char '-' >> natural ) >|= (fun i -> Int (-i)) <|> (natural >|= fun i -> Int i)) << ws(* Parse a name *)let parse_name : value parser = letter >>= fun c -> many ((satisfy is_alphanum) <|> (char '_') <|> (char '\'')) >>= fun cs -> ws >> pure (Name (implode (c :: cs)))(* Parse a const: int | bool | () *)let parse_const : value parser = parse_int <|> (keyword "True" >> pure (Bool true)) <|> (keyword "False">> pure (Bool false)) <|> (keyword "()" >> pure (Unit)) <|> parse_name(* Returns the integer value of an Int value *)let int_of_value (v : value) : int = match v with | Int i -> i | _ -> 0(* Parse command list until a given ending keyword is found *)let rec parse_coms (ending: string) (coms : command list) (cs : char list): (command list * char list) option = (match parse (ws >> keyword ending) (implode cs) with | Some (_, ts) -> Some (coms, ts) | None -> (match parse_com cs with | Some (com, ts) -> parse_coms ending (coms @ [com]) ts | None -> None))and(* Parse a command: Push const | Pop int | Trace int | Add int | Sub int | Mul int | Div int *)parse_com (cs : char list) : (command * char list) option = match parse (ws >> ((keyword "Push" >> parse_const >|= (fun c -> Push c)) <|> (keyword "Pop" >> parse_int >|= (fun i -> Pop (int_of_value i))) <|> (keyword "Trace" >> parse_int >|= (fun i -> Trace (int_of_value i))) <|> (keyword "Add" >> parse_int >|= (fun i -> Add (int_of_value i))) <|> (keyword "Sub" >> parse_int >|= (fun i -> Sub (int_of_value i))) <|> (keyword "Mul" >> parse_int >|= (fun i -> Mul (int_of_value i))) <|> (keyword "Div" >> parse_int >|= (fun i -> Div (int_of_value i))) <|> (keyword "And" >> pure And) <|> (keyword "Or" >> pure Or) <|> (keyword "Not" >> pure Not) <|> (keyword "Equal" >> pure Equal) <|> (keyword "Lte" >> pure Lte) <|> (keyword "Local" >> pure Local) <|> (keyword "Global" >> pure Global) <|> (keyword "Lookup" >> pure Lookup))) (implode cs) with | Some (c, ts) -> Some (c, ts) | None -> (match parse (ws >> ((keyword "Begin") >> pure (BeginEnd [])) <|> ((keyword "If") >> pure (IfElseEnd ([],[])))) (implode cs) with | Some (BeginEnd _, ts) -> (match parse_coms "End" [] ts with | Some ([], _) -> None | Some (coms, rs) -> Some (BeginEnd coms, rs) | None -> None) | Some (IfElseEnd (_, _), ts) -> (match parse_coms "Else" [] ts with | Some ([], _) -> None | Some (coms1, rs) -> (match parse_coms "End" [] rs with | Some ([], _) -> None | Some (coms2, ss) -> Some (IfElseEnd (coms1, coms2), ss) | None -> None) | None -> None) | _ -> None)(* Parse a list of commands separated by whitespaces *)let rec parse_comlst (src : char list) (ls : command list): command list option = match parse_com src with | Some (c, []) -> Some (ls @ [c]) | Some (c, tl) -> parse_comlst tl (ls @ [c]) | None -> None(* Returns the string representation of a value *)let val_to_string (v: value) : string = match v with | Int i -> string_of_int i | Bool true -> "True" | Bool false -> "False" | Unit -> "()" | Name s -> s(* Evaluates a Pop n command using the given stack *)let rec pop_n n (st : state) : state option = if n < 0 then None else if n == 0 then Some st else match st.stack with | [] -> None | hd::tl -> pop_n (n - 1) {st with stack = tl}(* Evaluates a Trace n command using the given stack and output list *)let rec trace_n n (st: state): state option = if n < 0 then None else if n == 0 then Some st else match st.stack with | [] -> None | hd::tl -> trace_n (n - 1) {st with stack = tl; out = val_to_string hd :: st.out}(* Evaluates an arithmetic command of n values using the given stack, the top value is operated by ftop,the remaining values in stack are operated using facc *)let rec eval_op_n (n : int) (top : int) (acc : int) (ftop : int -> int -> int) (facc : int -> int -> int option) (st: state): state option = if n < 0 then None else if n == 0 then Some {st with stack = (Int acc) :: st.stack} else match st.stack with | [] -> None | (Int i)::tl -> if n == top then eval_op_n (n - 1) top (ftop acc i) ftop facc {st with stack = tl} else (match facc acc i with | Some x -> eval_op_n (n - 1) top x ftop facc {st with stack = tl} | None -> None) | _ -> Nonelet eval2bool (f : bool -> bool -> bool) (st : state) : state option = match st.stack with | (Bool a)::(Bool b)::tl -> Some {st with stack = (Bool (f a b))::tl} | _ -> Nonelet eval2int (f : int -> int -> bool) (st : state) : state option = match st.stack with | (Int a)::(Int b)::tl -> Some {st with stack = (Bool (f a b))::tl} | _ -> None(* Evaluates a list of commands using the given stack, output list and environment *)let rec eval_comlst (cs : command list) (st : state): state option = match cs with | [] -> Some st | c::tl -> (match eval_com c st with | Some st' -> eval_comlst tl st' | None -> None)and(* Evaluates a command using the given stack and output list *)eval_com (c : command) (st : state): state option = match c with | Push v -> Some { st with stack = v :: st.stack} | Pop n -> pop_n n st | Trace n -> trace_n n st | Add n -> eval_op_n n n 0 (+) (fun a b -> Some (a + b)) st | Sub n -> eval_op_n n n 0 (+) (fun a b -> Some (a - b)) st | Mul n -> eval_op_n n n 1 ( * ) (fun a b -> Some (a * b)) st | Div n -> eval_op_n n n 1 ( * ) (fun a b -> if b != 0 then Some (a / b) else None) st | And -> eval2bool (&&) st | Or -> eval2bool (||) st | Not -> (match st.stack with | (Bool a)::tl -> Some {st with stack = (Bool (not a))::tl} | _ -> None) | Equal -> eval2int (==) st | Lte -> eval2int (<=) st | Local -> (match st.stack with | (Name a):: b::tl -> Some {st with stack = Unit::tl; local = Dict.add a b st.local} | _ -> None) | Global -> (match st.stack with | (Name a):: b::tl -> Some {st with stack = Unit::tl; global = Dict.add a b st.global} | _ -> None) | Lookup -> (match st.stack with | (Name a)::tl -> if Dict.mem a st.local then Some {st with stack = (Dict.find a st.local)::tl} else if Dict.mem a st.global then Some {st with stack = (Dict.find a st.global)::tl} else None | _ -> None) | BeginEnd coms -> (match eval_comlst coms {st with stack = []} with | Some st' -> (match st'.stack with | hd::tl -> Some {st with stack = hd::st.stack; global = st'.global} | _ -> None) | None -> None) | IfElseEnd (comst, comsf) -> (match st.stack with | (Bool b)::tl -> eval_comlst (if b then comst else comsf) {st with stack = tl} | _ -> None)(* Interprets a string of commands and returns the output list *)let interp (src : string) : string list = match parse_comlst (explode src) [] with | Some cs -> (match eval_comlst cs empty_state with | Some st -> st.out | None -> ["Error"]) | None -> ["Error"](* Calling (main "test.txt") will read the file test.txt and run interp on it. This is only used for debugging and will not be used by the gradescope autograder. *)let main fname = let src = readlines fname in interp src
Related Samples
Explore our Ocaml Assignments Sample Section for precise solutions. From functional programming basics to advanced recursion and data manipulation, delve into annotated code examples. Whether you're learning functional programming or tackling assignments, these samples offer clarity and expertise to excel in Ocaml effortlessly.
OCaml
Word Count
12229 Words
Writer Name:Dr. Heather M. More
Total Orders:800
Satisfaction rate:
OCaml
Word Count
7510 Words
Writer Name:Priya Nair
Total Orders:841
Satisfaction rate:
OCaml
Word Count
20285 Words
Writer Name:Prof. Benjamin Tan
Total Orders:911
Satisfaction rate:
OCaml
Word Count
1057 Words
Writer Name:Dr. Brian G. Hernandez
Total Orders:600
Satisfaction rate:
OCaml
Word Count
6509 Words
Writer Name:Dr. Kristen R. West
Total Orders:700
Satisfaction rate:
OCaml
Word Count
32909 Words
Writer Name:Dr. Brian G. Hernandez
Total Orders:600
Satisfaction rate:
OCaml
Word Count
4490 Words
Writer Name:Prof. Liam Anderson
Total Orders:944
Satisfaction rate:
OCaml
Word Count
3696 Words
Writer Name:Prof. Benjamin Reynolds
Total Orders:711
Satisfaction rate:
OCaml
Word Count
2987 Words
Writer Name:Prof. William Johnson
Total Orders:748
Satisfaction rate:
OCaml
Word Count
3673 Words
Writer Name:Prof. William Johnson
Total Orders:748
Satisfaction rate: