Prelude Code: exception NotImplemented exception ParserFailure (** MiniCAML Language Definition *) (* Types in MiniCAML *) type typ = Int |Bool | Pair of typ (* int *) (* bool *) typ (*11*12*) | Arrow of typ* typ (* t1 -> t2 *) (* We extend types with type variables to support type inference. ") Note that this does not have any surface syntax, and is used only for internal processing. | TVar of typ option ref (* Used for identifiers of variables *) type ident = string (The binary operations available in MiniCAML *) type bop= Equals (e1e2*) | LessThan (e1 < e2*) Plus | Minus (e1e2*) (*e1-e2*) Times (e1*e2*) (* The unary operations available in MiniCAML *) type uop = | Negate (*e*) (*Expressions in MiniCAML) type exp= Constl of int | PrimBop of exp* bop * exp PrimUop of uop* exp ConstB of bool If of exp* exp* exp Comma of exp* exp | LetComma of identident (-2-110 | 1 | 2 |... *) (e1 e2 *) (* e *) (* true | false *) (*if e then e1 else e2*) (* e1, e2*) exp exp (* let (x, y) = e1 in e2 end") (*Parser Primitives/Utilities *) module Parser: sig type input type 'a output type 'at input -> 'a output exception InvalidKeyword val run: 'at -> string -> 'a option val of value: 'a -> 'at (** read this as "and then" *) val (>): 'at-> ('a -> 'bt) -> 'bt (read this as "before") val (>>)'at-> 'bt-> 'bt val fail: 'a t val map ('a -> 'b) -> 'at -> 'bt val map2: ('a -> 'b-> 'c) -> 'at -> 'bt-> 'ct val map3: ('a -> 'b-> 'c -> 'd) -> 'at -> 'bt-> 'ct -> 'dt val const_map: 'b-> 'at-> 'bt val first_of_2: 'at->'at-> 'at val first of: 'a t list->'at 'at val many 'at -> 'a list t val some: : 'at -> 'a list t val sep_by: 'at -> 'bt -> 'a list t val sep_by_1: 'at -> 'bt -> 'a list t val optional: 'at -> 'a option t val skip: 'at -> unit t val no 'at -> unit t val between: unit t -> unitt-> 'at-> 'at val satisfy (char -> bool) -> chart val satisfy many: (char -> bool) -> string t val accept char: char -> chart val accept string string -> string t val eof: unit t val spaces: unit t val lexeme: 'at-> 'at val symbol: string -> unit t val keyword among string list -> string -> unit t (**[identifier_except] takes a list of keywords and fails if the current identifier is one of the keywords") val identifier except: string list -> strin (** [digits] only allows "0" or a number caracter sequence not starting with Os *) (** [digits] only allows "0" or a number character sequence not starting with Os *) val digits string t val int_digits: int t val prefix op: 'at-> 'bt-> ('a -> 'b-> 'b) -> 'bt val right_assoc_op: 'at-> 'bt-> ('b -> 'a -> 'b -> 'b) -> 'bt val left_assoc_op: 'at-> 'bt-> ('b-> 'a -> 'b -> 'b) -> 'bt val non assoc_op: 'at -> 'bt-> ('b-> 'a -> 'b-> 'b) -> 'bt end = struct let digit function '0'. '9' -> true |_ -> false let is nonzero_digit = function '1' .. '9' -> true |_ -> false let is alpha = function 'a' .. 'z' | 'A' .. 'Z' -> true |_ -> false let is_alphanum c = is_alpha c || is_digit c let _whitespace function ''|'\t' | '\' | '\n' -> true |_ -> false type input CStream.t type 'a output = 'a option CStream.t type 'at input -> 'a output exception InvalidKeyword let run pinp = CStream.of_string inp > p > fst let of value x = fun is ->(Some x, is) let (*>) pf fun is0 -> match p is0 with | Some a, is1-> fais1 | None, is1-> (None, is1) let (>>) pq pl> fun -> q let fail fun is ->(None, is) let map fp = p[*> fun a -> of_value (fa) let map2 fpq=pl⭑> fun a -> map (f a) q let map3 fpqr pl> fun a -> map2 (f a) qr let const_map cp = map (fun_ -> c) p let first_of_2 p q = fun is -> match p is with | None, _ -> q is | result ->result let rec first of ps = match ps with 10 -> fail Ip :: ps->first_of_2 p (first_of ps) let rec many p = first_of_2 (some p) (of_value[]) and some pp |> fun x -> map (fun xs -> x:: xs) (many p) let sep_by_1 p sep = map2 (fun x xs -> x: xs) p (many (sep (>> p)) let sep_by p sep = first_of_2 (sep_by_1 p sep) (of_value[]) let optional p = first_of_2 (map (fun a -> Some a) p) (of_value None) let skip p = map (fun ->()) p let no p = fun is -> match p is with | Some a, ->(None, is) | None, (Some (), is) let between p1 p2 q = p1 >> q l> fun a -> const_map a p2 let satisfy p = fun is0 -> match CStream.uncons is0 with | None ->(None, is0) | Some (c, is1) -> if p c then (Some c, is1) else (None, is0) let satisfy many p = fun is -> let str, rest CStream.take while p is in (Some str, rest) let accept char c=satisfy (fun c' -> c = c') let accept string s = let len String.lengths in fun is0 -> match CStream.take len is0 with | None -> (None, is0) | None ->(None, is0) | Some (s', is1) -> if s = s' then (Somes, is1) else (None, is0) let eof fun is -> if CStream.is_done is then (Some (), is) else (None, is) let spaces = skip (satisfy_many is_whitespace) (**[lexeme p] runs [p] and consumes all whitespaces after [p] if it succeeds. Otherwise, it backtracks. *) let lexeme p = first_of_2 p fail |*> fun a -> const_map a spaces let symbol s lexeme (skip (accept_string s)) let keyword among keywords s= if List.mem s keywords then lexeme (accept_string s >> no (satisfy is_alphanum)) else raise InvalidKeyword let identifier except keywords = lexeme (map2 (func cs-> String.make 1 c ^ cs) (satisfy is_alpha) (satisfy many is alphanum) > fun s-> if List.mem s keywords then fail else of values) let digits= lexeme (first_of_2 (const_map "0" (accept_char '0' >> no (satisfy is_digit))) (map2 (fun c cs->String.make 1 c^cs) (satisfy is_nonzero_digit) (satisfy many is_digit))) let int_digits=map (fun s -> int_of_string s) digits let prefix_op operatorp operando con = map2 (function Some op->con op | None -> fun a -> a) (optional operatorp) operandp let right_assoc_op operatorp operando con = map2 (fun a0 opbs -> List.fold right (fun (op, b) f a -> con a op (fb)) opbs (fun a -> a) a0) operandp (many (map2 (fun op b-> (op, b)) operatorp operandp)) let left assoc_op operatorp operando con = map2 (List.fold_left (fun a (op, b) -> con a op b)) operandp (many (map2 (fun op b-> (op, b)) operatorp operandp)) let non_assoc_op operatorp operando con = end map2 (fun a -> function | Some (op, b) -> con a op b | None -> a) operandp (optional (map2 (fun op b-> (op, b)) operatorp operandp)) A DIY programming language: MiniCAML Note: the prelude for this exercise quite long. However, we will point you to the useful functions in the prelude when relevant, so you shouldn't try to read it all at once. Note: you must not use references / assignment (:=) throughout Project 1 except Part 4. In this project, you will implement a language called MiniML (Project 1) and its extension (Project 2) in OCaml. This project allows you to have deeper operational understanding of the programming language concepts you have seen in the class and to use OCaml for a larger code base. | Fn of ident typ option * exp | Apply of exp * exp (* fnxt>e or fn x => e *) (* e1 e2 *) (*rec f : t => e or rec f => e *) | Rec of ident✶ typ option * exp | Let of ident exp* exp (* let x = e1 in e2 end *) | Var of ident (*x*) (* Charater Stream *) module CStream: sig type t val of_string: string -> t val is done: t -> bool val unconst-> (char *t) option val take: int -> t-> (string *t) option val take while (char -> bool) -> t -> string * t end = struct type t = {input: string; len: int; index: int} let of_string s = {input = s; len = String.length s; index = 0} let is done cscs.len = cs.index let uncons cs = if is_done cs then None else Some (cs.input. [cs.index], { cs with index = cs.index + 1}) let take | cs= let index = cs.index + I in if index <= cs.len then Some (String.sub cs.input cs.index I, { cs with index}) else None let take while pcs = let rec find_index i = in ifics.len || not (p cs.input.[i]) then i else find_index (i + 1) let index = find_index cs.index in In this first half of the project, namely Project 1, you will implement a parser, (weak) type inference, evaluation, and advanced type inference. Each of the components is a separate part, meaning that a wrong implementation of a part does not affect other parts. Part 1: Parsing As we described in the "Project Appendix" exercise, the starting point of processing a language is transforming a sequence of characters into an abstract syntax tree (AST). Programmers write a sequence of characters in their editors. Here, we provide the same module Parser that contains the primitives as in the exercise, so please check it out for the details of behaviours of these primitives. First, we show the grammar of MiniCAML as follows. atomic_typ="int" (* Integer type *) | "bool" (* Boolean type *) | "("type")" (* Parenthesized type *) pair_typ = atomic_typ "*" atomic_typ (* Pair type *) | atomic_typ typ = pair_typ "->" typ (* Arrow type, i.e. function type *) | pair_typ atomic_exp="true" "false" | digits (* Boolean constant true *) (*Boolean constant false *) (*Integer constants *) | ident (* Variables *) | "("exp ")" (* Parenthesized expression *) applicative_exp := applicative_exp" "atomic_exp (* Left associative function application *) | atomic_exp negatable_exp = "let" "(" ident "," ident ")" "=" exp "in" exp "end" (* Let comma binding *) | "let" ident "=" exp "in" exp "end" |"if" exp "then" exp "else" exp | "fn" ident [":" typ] "=>" exp annotation *) | "rec" ident [":" typ] "=>" exp annotation *) | applicative_exp (* Let binding *) (* If-then-else expression *) (* Function with optional type (* Recursion with optional type (String.sub cs.input cs.index (index - cs.index), {cs with index }) end negation_exp = ["-"] negatable_exp (* Prefix unary operation - *)
Prelude Code: exception NotImplemented exception ParserFailure (** MiniCAML Language Definition *) (* Types in MiniCAML *) type typ = Int |Bool | Pair of typ (* int *) (* bool *) typ (*11*12*) | Arrow of typ* typ (* t1 -> t2 *) (* We extend types with type variables to support type inference. ") Note that this does not have any surface syntax, and is used only for internal processing. | TVar of typ option ref (* Used for identifiers of variables *) type ident = string (The binary operations available in MiniCAML *) type bop= Equals (e1e2*) | LessThan (e1 < e2*) Plus | Minus (e1e2*) (*e1-e2*) Times (e1*e2*) (* The unary operations available in MiniCAML *) type uop = | Negate (*e*) (*Expressions in MiniCAML) type exp= Constl of int | PrimBop of exp* bop * exp PrimUop of uop* exp ConstB of bool If of exp* exp* exp Comma of exp* exp | LetComma of identident (-2-110 | 1 | 2 |... *) (e1 e2 *) (* e *) (* true | false *) (*if e then e1 else e2*) (* e1, e2*) exp exp (* let (x, y) = e1 in e2 end") (*Parser Primitives/Utilities *) module Parser: sig type input type 'a output type 'at input -> 'a output exception InvalidKeyword val run: 'at -> string -> 'a option val of value: 'a -> 'at (** read this as "and then" *) val (>): 'at-> ('a -> 'bt) -> 'bt (read this as "before") val (>>)'at-> 'bt-> 'bt val fail: 'a t val map ('a -> 'b) -> 'at -> 'bt val map2: ('a -> 'b-> 'c) -> 'at -> 'bt-> 'ct val map3: ('a -> 'b-> 'c -> 'd) -> 'at -> 'bt-> 'ct -> 'dt val const_map: 'b-> 'at-> 'bt val first_of_2: 'at->'at-> 'at val first of: 'a t list->'at 'at val many 'at -> 'a list t val some: : 'at -> 'a list t val sep_by: 'at -> 'bt -> 'a list t val sep_by_1: 'at -> 'bt -> 'a list t val optional: 'at -> 'a option t val skip: 'at -> unit t val no 'at -> unit t val between: unit t -> unitt-> 'at-> 'at val satisfy (char -> bool) -> chart val satisfy many: (char -> bool) -> string t val accept char: char -> chart val accept string string -> string t val eof: unit t val spaces: unit t val lexeme: 'at-> 'at val symbol: string -> unit t val keyword among string list -> string -> unit t (**[identifier_except] takes a list of keywords and fails if the current identifier is one of the keywords") val identifier except: string list -> strin (** [digits] only allows "0" or a number caracter sequence not starting with Os *) (** [digits] only allows "0" or a number character sequence not starting with Os *) val digits string t val int_digits: int t val prefix op: 'at-> 'bt-> ('a -> 'b-> 'b) -> 'bt val right_assoc_op: 'at-> 'bt-> ('b -> 'a -> 'b -> 'b) -> 'bt val left_assoc_op: 'at-> 'bt-> ('b-> 'a -> 'b -> 'b) -> 'bt val non assoc_op: 'at -> 'bt-> ('b-> 'a -> 'b-> 'b) -> 'bt end = struct let digit function '0'. '9' -> true |_ -> false let is nonzero_digit = function '1' .. '9' -> true |_ -> false let is alpha = function 'a' .. 'z' | 'A' .. 'Z' -> true |_ -> false let is_alphanum c = is_alpha c || is_digit c let _whitespace function ''|'\t' | '\' | '\n' -> true |_ -> false type input CStream.t type 'a output = 'a option CStream.t type 'at input -> 'a output exception InvalidKeyword let run pinp = CStream.of_string inp > p > fst let of value x = fun is ->(Some x, is) let (*>) pf fun is0 -> match p is0 with | Some a, is1-> fais1 | None, is1-> (None, is1) let (>>) pq pl> fun -> q let fail fun is ->(None, is) let map fp = p[*> fun a -> of_value (fa) let map2 fpq=pl⭑> fun a -> map (f a) q let map3 fpqr pl> fun a -> map2 (f a) qr let const_map cp = map (fun_ -> c) p let first_of_2 p q = fun is -> match p is with | None, _ -> q is | result ->result let rec first of ps = match ps with 10 -> fail Ip :: ps->first_of_2 p (first_of ps) let rec many p = first_of_2 (some p) (of_value[]) and some pp |> fun x -> map (fun xs -> x:: xs) (many p) let sep_by_1 p sep = map2 (fun x xs -> x: xs) p (many (sep (>> p)) let sep_by p sep = first_of_2 (sep_by_1 p sep) (of_value[]) let optional p = first_of_2 (map (fun a -> Some a) p) (of_value None) let skip p = map (fun ->()) p let no p = fun is -> match p is with | Some a, ->(None, is) | None, (Some (), is) let between p1 p2 q = p1 >> q l> fun a -> const_map a p2 let satisfy p = fun is0 -> match CStream.uncons is0 with | None ->(None, is0) | Some (c, is1) -> if p c then (Some c, is1) else (None, is0) let satisfy many p = fun is -> let str, rest CStream.take while p is in (Some str, rest) let accept char c=satisfy (fun c' -> c = c') let accept string s = let len String.lengths in fun is0 -> match CStream.take len is0 with | None -> (None, is0) | None ->(None, is0) | Some (s', is1) -> if s = s' then (Somes, is1) else (None, is0) let eof fun is -> if CStream.is_done is then (Some (), is) else (None, is) let spaces = skip (satisfy_many is_whitespace) (**[lexeme p] runs [p] and consumes all whitespaces after [p] if it succeeds. Otherwise, it backtracks. *) let lexeme p = first_of_2 p fail |*> fun a -> const_map a spaces let symbol s lexeme (skip (accept_string s)) let keyword among keywords s= if List.mem s keywords then lexeme (accept_string s >> no (satisfy is_alphanum)) else raise InvalidKeyword let identifier except keywords = lexeme (map2 (func cs-> String.make 1 c ^ cs) (satisfy is_alpha) (satisfy many is alphanum) > fun s-> if List.mem s keywords then fail else of values) let digits= lexeme (first_of_2 (const_map "0" (accept_char '0' >> no (satisfy is_digit))) (map2 (fun c cs->String.make 1 c^cs) (satisfy is_nonzero_digit) (satisfy many is_digit))) let int_digits=map (fun s -> int_of_string s) digits let prefix_op operatorp operando con = map2 (function Some op->con op | None -> fun a -> a) (optional operatorp) operandp let right_assoc_op operatorp operando con = map2 (fun a0 opbs -> List.fold right (fun (op, b) f a -> con a op (fb)) opbs (fun a -> a) a0) operandp (many (map2 (fun op b-> (op, b)) operatorp operandp)) let left assoc_op operatorp operando con = map2 (List.fold_left (fun a (op, b) -> con a op b)) operandp (many (map2 (fun op b-> (op, b)) operatorp operandp)) let non_assoc_op operatorp operando con = end map2 (fun a -> function | Some (op, b) -> con a op b | None -> a) operandp (optional (map2 (fun op b-> (op, b)) operatorp operandp)) A DIY programming language: MiniCAML Note: the prelude for this exercise quite long. However, we will point you to the useful functions in the prelude when relevant, so you shouldn't try to read it all at once. Note: you must not use references / assignment (:=) throughout Project 1 except Part 4. In this project, you will implement a language called MiniML (Project 1) and its extension (Project 2) in OCaml. This project allows you to have deeper operational understanding of the programming language concepts you have seen in the class and to use OCaml for a larger code base. | Fn of ident typ option * exp | Apply of exp * exp (* fnxt>e or fn x => e *) (* e1 e2 *) (*rec f : t => e or rec f => e *) | Rec of ident✶ typ option * exp | Let of ident exp* exp (* let x = e1 in e2 end *) | Var of ident (*x*) (* Charater Stream *) module CStream: sig type t val of_string: string -> t val is done: t -> bool val unconst-> (char *t) option val take: int -> t-> (string *t) option val take while (char -> bool) -> t -> string * t end = struct type t = {input: string; len: int; index: int} let of_string s = {input = s; len = String.length s; index = 0} let is done cscs.len = cs.index let uncons cs = if is_done cs then None else Some (cs.input. [cs.index], { cs with index = cs.index + 1}) let take | cs= let index = cs.index + I in if index <= cs.len then Some (String.sub cs.input cs.index I, { cs with index}) else None let take while pcs = let rec find_index i = in ifics.len || not (p cs.input.[i]) then i else find_index (i + 1) let index = find_index cs.index in In this first half of the project, namely Project 1, you will implement a parser, (weak) type inference, evaluation, and advanced type inference. Each of the components is a separate part, meaning that a wrong implementation of a part does not affect other parts. Part 1: Parsing As we described in the "Project Appendix" exercise, the starting point of processing a language is transforming a sequence of characters into an abstract syntax tree (AST). Programmers write a sequence of characters in their editors. Here, we provide the same module Parser that contains the primitives as in the exercise, so please check it out for the details of behaviours of these primitives. First, we show the grammar of MiniCAML as follows. atomic_typ="int" (* Integer type *) | "bool" (* Boolean type *) | "("type")" (* Parenthesized type *) pair_typ = atomic_typ "*" atomic_typ (* Pair type *) | atomic_typ typ = pair_typ "->" typ (* Arrow type, i.e. function type *) | pair_typ atomic_exp="true" "false" | digits (* Boolean constant true *) (*Boolean constant false *) (*Integer constants *) | ident (* Variables *) | "("exp ")" (* Parenthesized expression *) applicative_exp := applicative_exp" "atomic_exp (* Left associative function application *) | atomic_exp negatable_exp = "let" "(" ident "," ident ")" "=" exp "in" exp "end" (* Let comma binding *) | "let" ident "=" exp "in" exp "end" |"if" exp "then" exp "else" exp | "fn" ident [":" typ] "=>" exp annotation *) | "rec" ident [":" typ] "=>" exp annotation *) | applicative_exp (* Let binding *) (* If-then-else expression *) (* Function with optional type (* Recursion with optional type (String.sub cs.input cs.index (index - cs.index), {cs with index }) end negation_exp = ["-"] negatable_exp (* Prefix unary operation - *)
Database System Concepts
7th Edition
ISBN:9780078022159
Author:Abraham Silberschatz Professor, Henry F. Korth, S. Sudarshan
Publisher:Abraham Silberschatz Professor, Henry F. Korth, S. Sudarshan
Chapter1: Introduction
Section: Chapter Questions
Problem 1PE
Related questions
Question
Can you plz help me understand this with the answers, I really need help in details. its only one question
thanks a lot
![Prelude Code:
exception NotImplemented
exception ParserFailure
(** MiniCAML Language Definition *)
(* Types in MiniCAML *)
type typ =
Int
|Bool
| Pair of typ
(* int *)
(* bool *)
typ (*11*12*)
| Arrow of typ* typ (* t1 -> t2 *)
(* We extend types with type variables to support type inference.
")
Note that this does not have any surface syntax,
and is used only for internal processing.
| TVar of typ option ref
(* Used for identifiers of variables *)
type ident = string
(The binary operations available in MiniCAML *)
type bop=
Equals (e1e2*)
| LessThan (e1 < e2*)
Plus
| Minus
(e1e2*)
(*e1-e2*)
Times (e1*e2*)
(* The unary operations available in MiniCAML *)
type uop =
| Negate (*e*)
(*Expressions in MiniCAML)
type exp=
Constl of int
| PrimBop of exp* bop * exp
PrimUop of uop* exp
ConstB of bool
If of exp* exp* exp
Comma of exp* exp
| LetComma of identident
(-2-110 | 1 | 2 |... *)
(e1 <op> e2 *)
(* <op> e *)
(* true | false *)
(*if e then e1 else e2*)
(* e1, e2*)
exp exp (* let (x, y) = e1 in e2 end")
(*Parser Primitives/Utilities *)
module Parser: sig
type input
type 'a output
type 'at
input -> 'a output
exception InvalidKeyword
val run: 'at -> string -> 'a option
val of value: 'a -> 'at
(** read this as "and then" *)
val (>): 'at-> ('a -> 'bt) -> 'bt
(read this as "before")
val (>>)'at-> 'bt-> 'bt
val fail: 'a t
val map ('a -> 'b) -> 'at -> 'bt
val map2: ('a -> 'b-> 'c) -> 'at -> 'bt-> 'ct
val map3: ('a -> 'b-> 'c -> 'd) -> 'at -> 'bt-> 'ct -> 'dt
val const_map: 'b-> 'at-> 'bt
val first_of_2: 'at->'at-> 'at
val first of: 'a t list->'at
'at
val many 'at -> 'a list t
val some:
: 'at -> 'a list t
val sep_by: 'at -> 'bt -> 'a list t
val sep_by_1: 'at -> 'bt -> 'a list t
val optional: 'at -> 'a option t
val skip: 'at -> unit t
val no 'at -> unit t
val between: unit t -> unitt-> 'at-> 'at
val satisfy (char -> bool) -> chart
val satisfy many: (char -> bool) -> string t
val accept char: char -> chart
val accept string string -> string t
val eof: unit t
val spaces: unit t
val lexeme: 'at-> 'at
val symbol: string -> unit t
val keyword among string list -> string -> unit t
(**[identifier_except] takes a list of keywords and fails if the current identifier is one of the
keywords")
val identifier except: string list -> strin
(** [digits] only allows "0" or a number caracter sequence not starting with Os *)
(** [digits] only allows "0" or a number character sequence not starting with Os *)
val digits string t
val int_digits: int t
val prefix op: 'at-> 'bt-> ('a -> 'b-> 'b) -> 'bt
val right_assoc_op: 'at-> 'bt-> ('b -> 'a -> 'b -> 'b) -> 'bt
val left_assoc_op: 'at-> 'bt-> ('b-> 'a -> 'b -> 'b) -> 'bt
val non assoc_op: 'at -> 'bt-> ('b-> 'a -> 'b-> 'b) -> 'bt
end = struct
let
digit function '0'. '9' -> true |_ -> false
let is nonzero_digit = function '1' .. '9' -> true |_ -> false
let is alpha = function 'a' .. 'z' | 'A' .. 'Z' -> true |_ -> false
let is_alphanum c = is_alpha c || is_digit c
let
_whitespace function ''|'\t' | '\' | '\n' -> true |_ -> false
type input CStream.t
type 'a output = 'a option CStream.t
type 'at
input -> 'a output
exception InvalidKeyword
let run pinp = CStream.of_string inp > p > fst
let of value x = fun is ->(Some x, is)
let (*>) pf fun is0 ->
match p is0 with
| Some a, is1-> fais1
| None, is1-> (None, is1)
let (>>) pq pl> fun -> q
let fail fun is ->(None, is)
let map fp = p[*> fun a -> of_value (fa)
let map2 fpq=pl⭑> fun a -> map (f a) q
let map3 fpqr pl> fun a -> map2 (f a) qr
let const_map cp = map (fun_ -> c) p
let first_of_2 p q = fun is ->
match p is with
| None, _ -> q is
| result ->result
let rec first of ps =
match ps with
10 -> fail
Ip :: ps->first_of_2 p (first_of ps)
let rec many p = first_of_2 (some p) (of_value[])
and some pp |> fun x -> map (fun xs -> x:: xs) (many p)
let sep_by_1 p sep = map2 (fun x xs -> x: xs) p (many (sep (>> p))
let sep_by p sep = first_of_2 (sep_by_1 p sep) (of_value[])
let optional p = first_of_2 (map (fun a -> Some a) p) (of_value None)
let skip p = map (fun ->()) p
let no p = fun is ->
match p is with
| Some a, ->(None, is)
| None, (Some (), is)
let between p1 p2 q = p1 >> q l> fun a -> const_map a p2
let satisfy p = fun is0 ->
match CStream.uncons is0 with
| None ->(None, is0)
| Some (c, is1) ->
if p c
then (Some c, is1)
else (None, is0)
let satisfy many p =
fun is ->
let str, rest CStream.take while p is in
(Some str, rest)
let accept char c=satisfy (fun c' -> c = c')
let accept string s =
let len String.lengths in
fun is0 ->
match CStream.take len is0 with
| None -> (None, is0)
| None ->(None, is0)
| Some (s', is1) ->
if s = s'
then (Somes, is1)
else (None, is0)
let eof fun is ->
if CStream.is_done is
then (Some (), is)
else (None, is)
let spaces = skip (satisfy_many is_whitespace)
(**[lexeme p] runs [p] and
consumes all whitespaces after [p] if it succeeds.
Otherwise, it backtracks. *)
let lexeme p = first_of_2 p fail |*> fun a -> const_map a spaces
let symbol s lexeme (skip (accept_string s))
let keyword among keywords s=
if List.mem s keywords
then lexeme (accept_string s >> no (satisfy is_alphanum))
else raise InvalidKeyword
let identifier except keywords =
lexeme
(map2
(func cs-> String.make 1 c ^ cs)
(satisfy is_alpha)
(satisfy many is alphanum)
> fun s->
if List.mem s keywords
then fail
else of values)
let digits=
lexeme
(first_of_2
(const_map "0" (accept_char '0' >> no (satisfy is_digit)))
(map2
(fun c cs->String.make 1 c^cs)
(satisfy is_nonzero_digit)
(satisfy many is_digit)))
let int_digits=map (fun s -> int_of_string s) digits
let prefix_op operatorp operando con =
map2
(function
Some op->con op
| None -> fun a -> a)
(optional operatorp)
operandp
let right_assoc_op operatorp operando con =
map2
(fun a0 opbs -> List.fold right (fun (op, b) f a -> con a op (fb)) opbs (fun a -> a) a0)
operandp
(many (map2 (fun op b-> (op, b)) operatorp operandp))
let left assoc_op operatorp operando con =
map2
(List.fold_left (fun a (op, b) -> con a op b))
operandp
(many (map2 (fun op b-> (op, b)) operatorp operandp))
let non_assoc_op operatorp operando con =
end
map2
(fun a ->
function
| Some (op, b) -> con a op b
| None -> a)
operandp
(optional (map2 (fun op b-> (op, b)) operatorp operandp))
A DIY programming language: MiniCAML
Note: the prelude for this exercise quite long. However, we will point you to the useful
functions in the prelude when relevant, so you shouldn't try to read it all at once.
Note: you must not use references / assignment (:=) throughout Project 1 except Part 4.
In this project, you will implement a language called MiniML (Project 1) and its extension
(Project 2) in OCaml. This project allows you to have deeper operational understanding of
the programming language concepts you have seen in the class and to use OCaml for a
larger code base.](/v2/_next/image?url=https%3A%2F%2Fcontent.bartleby.com%2Fqna-images%2Fquestion%2F303ccd0e-2dda-49db-acba-28752381abfe%2Fa8474829-39f8-43d3-817e-0c6783beb896%2F1wfnpe_processed.png&w=3840&q=75)
Transcribed Image Text:Prelude Code:
exception NotImplemented
exception ParserFailure
(** MiniCAML Language Definition *)
(* Types in MiniCAML *)
type typ =
Int
|Bool
| Pair of typ
(* int *)
(* bool *)
typ (*11*12*)
| Arrow of typ* typ (* t1 -> t2 *)
(* We extend types with type variables to support type inference.
")
Note that this does not have any surface syntax,
and is used only for internal processing.
| TVar of typ option ref
(* Used for identifiers of variables *)
type ident = string
(The binary operations available in MiniCAML *)
type bop=
Equals (e1e2*)
| LessThan (e1 < e2*)
Plus
| Minus
(e1e2*)
(*e1-e2*)
Times (e1*e2*)
(* The unary operations available in MiniCAML *)
type uop =
| Negate (*e*)
(*Expressions in MiniCAML)
type exp=
Constl of int
| PrimBop of exp* bop * exp
PrimUop of uop* exp
ConstB of bool
If of exp* exp* exp
Comma of exp* exp
| LetComma of identident
(-2-110 | 1 | 2 |... *)
(e1 <op> e2 *)
(* <op> e *)
(* true | false *)
(*if e then e1 else e2*)
(* e1, e2*)
exp exp (* let (x, y) = e1 in e2 end")
(*Parser Primitives/Utilities *)
module Parser: sig
type input
type 'a output
type 'at
input -> 'a output
exception InvalidKeyword
val run: 'at -> string -> 'a option
val of value: 'a -> 'at
(** read this as "and then" *)
val (>): 'at-> ('a -> 'bt) -> 'bt
(read this as "before")
val (>>)'at-> 'bt-> 'bt
val fail: 'a t
val map ('a -> 'b) -> 'at -> 'bt
val map2: ('a -> 'b-> 'c) -> 'at -> 'bt-> 'ct
val map3: ('a -> 'b-> 'c -> 'd) -> 'at -> 'bt-> 'ct -> 'dt
val const_map: 'b-> 'at-> 'bt
val first_of_2: 'at->'at-> 'at
val first of: 'a t list->'at
'at
val many 'at -> 'a list t
val some:
: 'at -> 'a list t
val sep_by: 'at -> 'bt -> 'a list t
val sep_by_1: 'at -> 'bt -> 'a list t
val optional: 'at -> 'a option t
val skip: 'at -> unit t
val no 'at -> unit t
val between: unit t -> unitt-> 'at-> 'at
val satisfy (char -> bool) -> chart
val satisfy many: (char -> bool) -> string t
val accept char: char -> chart
val accept string string -> string t
val eof: unit t
val spaces: unit t
val lexeme: 'at-> 'at
val symbol: string -> unit t
val keyword among string list -> string -> unit t
(**[identifier_except] takes a list of keywords and fails if the current identifier is one of the
keywords")
val identifier except: string list -> strin
(** [digits] only allows "0" or a number caracter sequence not starting with Os *)
(** [digits] only allows "0" or a number character sequence not starting with Os *)
val digits string t
val int_digits: int t
val prefix op: 'at-> 'bt-> ('a -> 'b-> 'b) -> 'bt
val right_assoc_op: 'at-> 'bt-> ('b -> 'a -> 'b -> 'b) -> 'bt
val left_assoc_op: 'at-> 'bt-> ('b-> 'a -> 'b -> 'b) -> 'bt
val non assoc_op: 'at -> 'bt-> ('b-> 'a -> 'b-> 'b) -> 'bt
end = struct
let
digit function '0'. '9' -> true |_ -> false
let is nonzero_digit = function '1' .. '9' -> true |_ -> false
let is alpha = function 'a' .. 'z' | 'A' .. 'Z' -> true |_ -> false
let is_alphanum c = is_alpha c || is_digit c
let
_whitespace function ''|'\t' | '\' | '\n' -> true |_ -> false
type input CStream.t
type 'a output = 'a option CStream.t
type 'at
input -> 'a output
exception InvalidKeyword
let run pinp = CStream.of_string inp > p > fst
let of value x = fun is ->(Some x, is)
let (*>) pf fun is0 ->
match p is0 with
| Some a, is1-> fais1
| None, is1-> (None, is1)
let (>>) pq pl> fun -> q
let fail fun is ->(None, is)
let map fp = p[*> fun a -> of_value (fa)
let map2 fpq=pl⭑> fun a -> map (f a) q
let map3 fpqr pl> fun a -> map2 (f a) qr
let const_map cp = map (fun_ -> c) p
let first_of_2 p q = fun is ->
match p is with
| None, _ -> q is
| result ->result
let rec first of ps =
match ps with
10 -> fail
Ip :: ps->first_of_2 p (first_of ps)
let rec many p = first_of_2 (some p) (of_value[])
and some pp |> fun x -> map (fun xs -> x:: xs) (many p)
let sep_by_1 p sep = map2 (fun x xs -> x: xs) p (many (sep (>> p))
let sep_by p sep = first_of_2 (sep_by_1 p sep) (of_value[])
let optional p = first_of_2 (map (fun a -> Some a) p) (of_value None)
let skip p = map (fun ->()) p
let no p = fun is ->
match p is with
| Some a, ->(None, is)
| None, (Some (), is)
let between p1 p2 q = p1 >> q l> fun a -> const_map a p2
let satisfy p = fun is0 ->
match CStream.uncons is0 with
| None ->(None, is0)
| Some (c, is1) ->
if p c
then (Some c, is1)
else (None, is0)
let satisfy many p =
fun is ->
let str, rest CStream.take while p is in
(Some str, rest)
let accept char c=satisfy (fun c' -> c = c')
let accept string s =
let len String.lengths in
fun is0 ->
match CStream.take len is0 with
| None -> (None, is0)
| None ->(None, is0)
| Some (s', is1) ->
if s = s'
then (Somes, is1)
else (None, is0)
let eof fun is ->
if CStream.is_done is
then (Some (), is)
else (None, is)
let spaces = skip (satisfy_many is_whitespace)
(**[lexeme p] runs [p] and
consumes all whitespaces after [p] if it succeeds.
Otherwise, it backtracks. *)
let lexeme p = first_of_2 p fail |*> fun a -> const_map a spaces
let symbol s lexeme (skip (accept_string s))
let keyword among keywords s=
if List.mem s keywords
then lexeme (accept_string s >> no (satisfy is_alphanum))
else raise InvalidKeyword
let identifier except keywords =
lexeme
(map2
(func cs-> String.make 1 c ^ cs)
(satisfy is_alpha)
(satisfy many is alphanum)
> fun s->
if List.mem s keywords
then fail
else of values)
let digits=
lexeme
(first_of_2
(const_map "0" (accept_char '0' >> no (satisfy is_digit)))
(map2
(fun c cs->String.make 1 c^cs)
(satisfy is_nonzero_digit)
(satisfy many is_digit)))
let int_digits=map (fun s -> int_of_string s) digits
let prefix_op operatorp operando con =
map2
(function
Some op->con op
| None -> fun a -> a)
(optional operatorp)
operandp
let right_assoc_op operatorp operando con =
map2
(fun a0 opbs -> List.fold right (fun (op, b) f a -> con a op (fb)) opbs (fun a -> a) a0)
operandp
(many (map2 (fun op b-> (op, b)) operatorp operandp))
let left assoc_op operatorp operando con =
map2
(List.fold_left (fun a (op, b) -> con a op b))
operandp
(many (map2 (fun op b-> (op, b)) operatorp operandp))
let non_assoc_op operatorp operando con =
end
map2
(fun a ->
function
| Some (op, b) -> con a op b
| None -> a)
operandp
(optional (map2 (fun op b-> (op, b)) operatorp operandp))
A DIY programming language: MiniCAML
Note: the prelude for this exercise quite long. However, we will point you to the useful
functions in the prelude when relevant, so you shouldn't try to read it all at once.
Note: you must not use references / assignment (:=) throughout Project 1 except Part 4.
In this project, you will implement a language called MiniML (Project 1) and its extension
(Project 2) in OCaml. This project allows you to have deeper operational understanding of
the programming language concepts you have seen in the class and to use OCaml for a
larger code base.
![| Fn of ident typ option * exp
| Apply of exp * exp
(* fnxt>e or fn x => e *)
(* e1 e2 *)
(*rec f : t => e or rec f => e *)
| Rec of ident✶ typ option * exp
| Let of ident exp* exp
(* let x = e1 in e2 end *)
| Var of ident
(*x*)
(* Charater Stream *)
module CStream: sig
type t
val of_string: string -> t
val is done: t -> bool
val unconst-> (char *t) option
val take: int -> t-> (string *t) option
val take while (char -> bool) -> t -> string * t
end = struct
type t = {input: string; len: int; index: int}
let of_string s = {input = s; len = String.length s; index = 0}
let is done cscs.len = cs.index
let uncons cs =
if is_done cs
then None
else Some (cs.input. [cs.index], { cs with index = cs.index + 1})
let take | cs=
let index = cs.index + I in
if index <= cs.len
then Some (String.sub cs.input cs.index I, { cs with index})
else None
let take while pcs =
let rec find_index i =
in
ifics.len || not (p cs.input.[i])
then i
else find_index (i + 1)
let index = find_index cs.index in
In this first half of the project, namely Project 1, you will implement a parser, (weak) type
inference, evaluation, and advanced type inference. Each of the components is a separate
part, meaning that a wrong implementation of a part does not affect other parts.
Part 1: Parsing
As we described in the "Project Appendix" exercise, the starting point of processing a
language is transforming a sequence of characters into an abstract syntax tree (AST).
Programmers write a sequence of characters in their editors. Here, we provide the same
module Parser that contains the primitives as in the exercise, so please check it out for the
details of behaviours of these primitives.
First, we show the grammar of MiniCAML as follows.
atomic_typ="int"
(* Integer type *)
| "bool" (* Boolean type *)
| "("type")" (* Parenthesized type *)
pair_typ = atomic_typ "*" atomic_typ (* Pair type *)
| atomic_typ
typ = pair_typ "->" typ (* Arrow type, i.e. function type *)
| pair_typ
atomic_exp="true"
"false"
| digits
(* Boolean constant true *)
(*Boolean constant false *)
(*Integer constants *)
| ident (* Variables *)
| "("exp ")" (* Parenthesized expression *)
applicative_exp := applicative_exp" "atomic_exp (* Left associative function application *)
| atomic_exp
negatable_exp = "let" "(" ident "," ident ")" "=" exp "in" exp "end" (* Let comma binding *)
| "let" ident "=" exp "in" exp "end"
|"if" exp "then" exp "else" exp
| "fn" ident [":" typ] "=>" exp
annotation *)
| "rec" ident [":" typ] "=>" exp
annotation *)
| applicative_exp
(* Let binding *)
(* If-then-else expression *)
(* Function with optional type
(* Recursion with optional type
(String.sub cs.input cs.index (index - cs.index), {cs with index })
end
negation_exp = ["-"] negatable_exp (* Prefix unary operation - *)](/v2/_next/image?url=https%3A%2F%2Fcontent.bartleby.com%2Fqna-images%2Fquestion%2F303ccd0e-2dda-49db-acba-28752381abfe%2Fa8474829-39f8-43d3-817e-0c6783beb896%2Fxc8cvaf_processed.jpeg&w=3840&q=75)
Transcribed Image Text:| Fn of ident typ option * exp
| Apply of exp * exp
(* fnxt>e or fn x => e *)
(* e1 e2 *)
(*rec f : t => e or rec f => e *)
| Rec of ident✶ typ option * exp
| Let of ident exp* exp
(* let x = e1 in e2 end *)
| Var of ident
(*x*)
(* Charater Stream *)
module CStream: sig
type t
val of_string: string -> t
val is done: t -> bool
val unconst-> (char *t) option
val take: int -> t-> (string *t) option
val take while (char -> bool) -> t -> string * t
end = struct
type t = {input: string; len: int; index: int}
let of_string s = {input = s; len = String.length s; index = 0}
let is done cscs.len = cs.index
let uncons cs =
if is_done cs
then None
else Some (cs.input. [cs.index], { cs with index = cs.index + 1})
let take | cs=
let index = cs.index + I in
if index <= cs.len
then Some (String.sub cs.input cs.index I, { cs with index})
else None
let take while pcs =
let rec find_index i =
in
ifics.len || not (p cs.input.[i])
then i
else find_index (i + 1)
let index = find_index cs.index in
In this first half of the project, namely Project 1, you will implement a parser, (weak) type
inference, evaluation, and advanced type inference. Each of the components is a separate
part, meaning that a wrong implementation of a part does not affect other parts.
Part 1: Parsing
As we described in the "Project Appendix" exercise, the starting point of processing a
language is transforming a sequence of characters into an abstract syntax tree (AST).
Programmers write a sequence of characters in their editors. Here, we provide the same
module Parser that contains the primitives as in the exercise, so please check it out for the
details of behaviours of these primitives.
First, we show the grammar of MiniCAML as follows.
atomic_typ="int"
(* Integer type *)
| "bool" (* Boolean type *)
| "("type")" (* Parenthesized type *)
pair_typ = atomic_typ "*" atomic_typ (* Pair type *)
| atomic_typ
typ = pair_typ "->" typ (* Arrow type, i.e. function type *)
| pair_typ
atomic_exp="true"
"false"
| digits
(* Boolean constant true *)
(*Boolean constant false *)
(*Integer constants *)
| ident (* Variables *)
| "("exp ")" (* Parenthesized expression *)
applicative_exp := applicative_exp" "atomic_exp (* Left associative function application *)
| atomic_exp
negatable_exp = "let" "(" ident "," ident ")" "=" exp "in" exp "end" (* Let comma binding *)
| "let" ident "=" exp "in" exp "end"
|"if" exp "then" exp "else" exp
| "fn" ident [":" typ] "=>" exp
annotation *)
| "rec" ident [":" typ] "=>" exp
annotation *)
| applicative_exp
(* Let binding *)
(* If-then-else expression *)
(* Function with optional type
(* Recursion with optional type
(String.sub cs.input cs.index (index - cs.index), {cs with index })
end
negation_exp = ["-"] negatable_exp (* Prefix unary operation - *)
Expert Solution
This question has been solved!
Explore an expertly crafted, step-by-step solution for a thorough understanding of key concepts.
Step by step
Solved in 2 steps
Recommended textbooks for you
Database System Concepts
Computer Science
ISBN:
9780078022159
Author:
Abraham Silberschatz Professor, Henry F. Korth, S. Sudarshan
Publisher:
McGraw-Hill Education
Starting Out with Python (4th Edition)
Computer Science
ISBN:
9780134444321
Author:
Tony Gaddis
Publisher:
PEARSON
Digital Fundamentals (11th Edition)
Computer Science
ISBN:
9780132737968
Author:
Thomas L. Floyd
Publisher:
PEARSON
Database System Concepts
Computer Science
ISBN:
9780078022159
Author:
Abraham Silberschatz Professor, Henry F. Korth, S. Sudarshan
Publisher:
McGraw-Hill Education
Starting Out with Python (4th Edition)
Computer Science
ISBN:
9780134444321
Author:
Tony Gaddis
Publisher:
PEARSON
Digital Fundamentals (11th Edition)
Computer Science
ISBN:
9780132737968
Author:
Thomas L. Floyd
Publisher:
PEARSON
C How to Program (8th Edition)
Computer Science
ISBN:
9780133976892
Author:
Paul J. Deitel, Harvey Deitel
Publisher:
PEARSON
Database Systems: Design, Implementation, & Manag…
Computer Science
ISBN:
9781337627900
Author:
Carlos Coronel, Steven Morris
Publisher:
Cengage Learning
Programmable Logic Controllers
Computer Science
ISBN:
9780073373843
Author:
Frank D. Petruzella
Publisher:
McGraw-Hill Education