Add all the assignment code.
Signed-off-by: jmug <u.g.a.mariano@gmail.com>
This commit is contained in:
parent
58c6b1f81c
commit
cfe502c598
1277 changed files with 48709 additions and 1 deletions
195
hw1/lib/util/assert.ml
Normal file
195
hw1/lib/util/assert.ml
Normal file
|
|
@ -0,0 +1,195 @@
|
|||
(* CIS341 Assertion Testing and Grading Infrastructure *)
|
||||
(* Author: Steve Zdancewic *)
|
||||
|
||||
(* Do NOT modify this file -- we will overwrite it *)
|
||||
(* with our own version when testing your code. *)
|
||||
|
||||
(* An assertion is just a unit->unit function that either *)
|
||||
(* succeeds silently or throws an Failure exception. *)
|
||||
type assertion = unit -> unit
|
||||
|
||||
type 'a test =
|
||||
| GradedTest of string * int * (string * 'a) list
|
||||
| Test of string * (string * 'a) list
|
||||
|
||||
type suite = assertion test list
|
||||
|
||||
(**************)
|
||||
(* Assertions *)
|
||||
|
||||
let assert_eq v1 v2 : assertion =
|
||||
fun () -> if v1 <> v2 then failwith "not equal" else ()
|
||||
|
||||
|
||||
let assert_eqf f v2 : assertion =
|
||||
fun () -> if f () <> v2 then failwith "not equal" else ()
|
||||
|
||||
|
||||
let assert_eqfs f v2 : assertion =
|
||||
fun () ->
|
||||
let s1 = f () in
|
||||
if s1 <> v2
|
||||
then failwith @@ Printf.sprintf "not equal\n\texpected:%s\n\tgot:%s\n" v2 s1
|
||||
else ()
|
||||
|
||||
|
||||
let assert_fail : assertion = fun () -> failwith "assert fail"
|
||||
|
||||
exception Timeout
|
||||
|
||||
let timeout_assert (time : int) (a : assertion) : assertion =
|
||||
fun () ->
|
||||
let handler = Sys.Signal_handle (fun _ -> raise Timeout) in
|
||||
let old = Sys.signal Sys.sigalrm handler in
|
||||
let reset_sigalrm () = Sys.set_signal Sys.sigalrm old in
|
||||
ignore (Unix.alarm time) ;
|
||||
try
|
||||
a () ;
|
||||
reset_sigalrm ()
|
||||
with
|
||||
| Timeout ->
|
||||
reset_sigalrm () ;
|
||||
failwith @@ Printf.sprintf "Timed out after %d seconds" time
|
||||
| exc ->
|
||||
reset_sigalrm () ;
|
||||
raise exc
|
||||
|
||||
|
||||
let timeout_test (time : int) (t : assertion test) : assertion test =
|
||||
let map_timeout l = List.map (fun (i, a) -> (i, timeout_assert time a)) l in
|
||||
match t with
|
||||
| GradedTest (s, i, ls) ->
|
||||
GradedTest (s, i, map_timeout ls)
|
||||
| Test (s, ls) ->
|
||||
Test (s, map_timeout ls)
|
||||
|
||||
|
||||
let timeout_suite (time : int) (s : suite) : suite =
|
||||
List.map (timeout_test time) s
|
||||
|
||||
|
||||
(***************************)
|
||||
(* Generating Test Results *)
|
||||
|
||||
type result =
|
||||
| Pass
|
||||
| Fail of string
|
||||
|
||||
type outcome = result test list
|
||||
|
||||
let run_assertion (f : assertion) : result =
|
||||
try
|
||||
f () ;
|
||||
Pass
|
||||
with
|
||||
| Failure m ->
|
||||
Fail m
|
||||
| e ->
|
||||
Fail ("test threw exception: " ^ Printexc.to_string e)
|
||||
|
||||
|
||||
let run_test (t : assertion test) : result test =
|
||||
let run_case (cn, f) = (cn, run_assertion f) in
|
||||
match t with
|
||||
| GradedTest (n, s, cases) ->
|
||||
Printf.eprintf "Running test %s\n%!" n ;
|
||||
GradedTest (n, s, List.map run_case cases)
|
||||
| Test (n, cases) ->
|
||||
Printf.eprintf "Running test %s\n%!" n ;
|
||||
Test (n, List.map run_case cases)
|
||||
|
||||
|
||||
let run_suite (s : suite) : outcome = List.map run_test s
|
||||
|
||||
(***********************)
|
||||
(* Reporting functions *)
|
||||
|
||||
let result_test_to_string (name_pts : string) (r : result test) : string =
|
||||
let string_of_case (name, res) =
|
||||
match res with
|
||||
| Pass ->
|
||||
"passed - " ^ name
|
||||
| Fail msg ->
|
||||
"FAILED - " ^ name ^ ": " ^ msg
|
||||
in
|
||||
match r with
|
||||
| GradedTest (_, _, cases) | Test (_, cases) ->
|
||||
name_pts
|
||||
^ List.fold_left
|
||||
(fun rest case -> rest ^ "\n" ^ string_of_case case)
|
||||
""
|
||||
cases
|
||||
|
||||
|
||||
(* Number of digits of precision for a float x. Argument p is the number of decimal places desired (must be at least 1) *)
|
||||
let prec_digits p x = (int_of_float @@ floor @@ log10 x) + (1 + p)
|
||||
|
||||
(* returns (name_pts, passed, failed, total, points_earned, max_given, max_hidden) *)
|
||||
let get_results (t : result test) =
|
||||
let num_passed cases =
|
||||
List.fold_left
|
||||
(fun cnt (_, r) -> match r with Pass -> cnt + 1 | _ -> cnt)
|
||||
0
|
||||
cases
|
||||
in
|
||||
let num_failed cases =
|
||||
List.fold_left
|
||||
(fun cnt (_, r) -> match r with Fail _ -> cnt + 1 | _ -> cnt)
|
||||
0
|
||||
cases
|
||||
in
|
||||
match t with
|
||||
| GradedTest (name, pts, cases) ->
|
||||
let passed = num_passed cases in
|
||||
let failed = num_failed cases in
|
||||
let total = List.length cases in
|
||||
if total > 0
|
||||
then
|
||||
let points_earned = ((float_of_int passed) /. (float_of_int total)) *. (float_of_int pts) in
|
||||
let name_pts =
|
||||
Printf.sprintf "%s (%1.*g/%d points = %d/%d tests)" name (prec_digits 1 points_earned) points_earned pts passed total
|
||||
in
|
||||
(name_pts, passed, failed, total, points_earned, pts, 0)
|
||||
else
|
||||
let name_pts = Printf.sprintf "%s (?/%d points)" name pts in
|
||||
(name_pts, passed, failed, total, 0.0, 0, pts)
|
||||
| Test (name, cases) ->
|
||||
let total = List.length cases in
|
||||
let passed = num_passed cases in
|
||||
let failed = num_failed cases in
|
||||
(name, passed, failed, total, 0.0, 0, 0)
|
||||
|
||||
|
||||
let outcome_to_string (o : outcome) : string =
|
||||
let sep = "\n---------------------------------------------------\n" in
|
||||
let helper (passed, failed, total, pts, maxg, maxh, str) (t : result test) =
|
||||
let name_pts, p, f, tot, s, mg, mh = get_results t in
|
||||
( passed + p
|
||||
, failed + f
|
||||
, total + tot
|
||||
, s +. pts
|
||||
, maxg + mg
|
||||
, maxh + mh
|
||||
, str
|
||||
^ "\n"
|
||||
^
|
||||
if f > 0
|
||||
then result_test_to_string name_pts t
|
||||
else if tot > 0
|
||||
then name_pts ^ ":\n OK"
|
||||
else name_pts ^ ":\n Hidden" )
|
||||
in
|
||||
let p, f, tot, pts, maxg, maxh, str =
|
||||
List.fold_left helper (0, 0, 0, 0.0, 0, 0, "") o
|
||||
in
|
||||
str
|
||||
^ sep
|
||||
^ Printf.sprintf
|
||||
"Passed: %d/%d\n\
|
||||
Failed: %d/%d\n\
|
||||
Score: %1.1f/%d (given)\n\
|
||||
\ ?/%d (hidden)"
|
||||
p tot
|
||||
f tot
|
||||
pts maxg
|
||||
maxh
|
||||
57
hw1/lib/util/assert.mli
Normal file
57
hw1/lib/util/assert.mli
Normal file
|
|
@ -0,0 +1,57 @@
|
|||
(* CIS341 Assertion Testing and Grading Infrastructure *)
|
||||
(* Author: Steve Zdancewic *)
|
||||
|
||||
(* Do NOT modify this file -- we will overwrite it *)
|
||||
(* with our own version when testing your code. *)
|
||||
|
||||
exception Timeout
|
||||
|
||||
(* An assertion is just a unit->unit function that either *)
|
||||
(* succeeds silently or throws an Failure exception. *)
|
||||
type assertion = unit -> unit
|
||||
|
||||
type 'a test =
|
||||
| GradedTest of string * int * (string * 'a) list
|
||||
| Test of string * (string * 'a) list
|
||||
|
||||
type suite = assertion test list
|
||||
|
||||
(**************)
|
||||
(* Assertions *)
|
||||
|
||||
val assert_eq : 'a -> 'a -> assertion
|
||||
|
||||
val assert_eqf : (unit -> 'a) -> 'a -> assertion
|
||||
|
||||
val assert_eqfs : (unit -> string) -> string -> assertion
|
||||
|
||||
val assert_fail : assertion
|
||||
|
||||
val timeout_assert : int -> assertion -> assertion
|
||||
|
||||
val timeout_test : int -> assertion test -> assertion test
|
||||
|
||||
val timeout_suite : int -> suite -> suite
|
||||
|
||||
(***************************)
|
||||
(* Generating Test Results *)
|
||||
|
||||
type result =
|
||||
| Pass
|
||||
| Fail of string
|
||||
|
||||
type outcome = result test list
|
||||
|
||||
val run_assertion : assertion -> result
|
||||
|
||||
val run_test : assertion test -> result test
|
||||
|
||||
val run_suite : suite -> outcome
|
||||
|
||||
(***********************)
|
||||
(* Reporting functions *)
|
||||
|
||||
val result_test_to_string : string -> result test -> string
|
||||
|
||||
(* val get_results result test -> (string * int * int * int * float * int * int) *)
|
||||
val outcome_to_string : outcome -> string
|
||||
3
hw1/lib/util/dune
Normal file
3
hw1/lib/util/dune
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(library
|
||||
(name util)
|
||||
(libraries str unix))
|
||||
237
hw1/lib/util/platform.ml
Normal file
237
hw1/lib/util/platform.ml
Normal file
|
|
@ -0,0 +1,237 @@
|
|||
(* -------------------------------------------------------------------------- *)
|
||||
(** Assembling and linking for X86. Depends on the underlying OS platform *)
|
||||
|
||||
open Printf
|
||||
open Unix
|
||||
|
||||
exception PlatformError of string * string
|
||||
|
||||
(* paths -------------------------------------------------------------------- *)
|
||||
let path_sep = "/"
|
||||
|
||||
let bin_path = "./bin"
|
||||
|
||||
let dot_path = "./"
|
||||
|
||||
let executable_name = ref "a.out"
|
||||
|
||||
let output_path = ref "output"
|
||||
|
||||
let libs = ref []
|
||||
|
||||
let lib_paths = ref []
|
||||
|
||||
let lib_search_paths = ref []
|
||||
|
||||
let include_paths = ref []
|
||||
|
||||
(* unix utility scripts ----------------------------------------------------- *)
|
||||
let pp_cmd = ref "cpp -E "
|
||||
|
||||
let rm_cmd = ref "rm -rf "
|
||||
|
||||
(* -------------------------------------------------------------------------- *)
|
||||
(* Platform specific configuration: Unix/Linux vs. Mac OS X *)
|
||||
|
||||
let os =
|
||||
let ic = Unix.open_process_in "uname -s" in
|
||||
let uname = input_line ic in
|
||||
let () = close_in ic in
|
||||
uname
|
||||
|
||||
let cpu =
|
||||
let ic = Unix.open_process_in "uname -m" in
|
||||
let cpuname = input_line ic in
|
||||
let () = close_in ic in
|
||||
cpuname
|
||||
|
||||
(* One of "Darwin" or "Linux" *)
|
||||
|
||||
let linux = ref false
|
||||
|
||||
let mangle name = if !linux then name else "_" ^ name
|
||||
|
||||
let osx_target_triple = "x86_64-apple-macosx10.13.0"
|
||||
|
||||
let linux_target_triple = "x86_64-unknown-linux"
|
||||
|
||||
let target_triple = ref osx_target_triple
|
||||
|
||||
let platform_flags = ref ""
|
||||
|
||||
(* Set the link commands properly, ensure output directory exists *)
|
||||
let configure_os () =
|
||||
if os = "Linux"
|
||||
then (
|
||||
linux := true ;
|
||||
target_triple := linux_target_triple ;
|
||||
platform_flags := "" )
|
||||
else if os = "Darwin"
|
||||
then (
|
||||
linux := false ;
|
||||
target_triple := osx_target_triple ;
|
||||
platform_flags := "-fno-asynchronous-unwind-tables -mstackrealign" )
|
||||
else failwith @@ "Unsupported OS detected: " ^ os
|
||||
|
||||
|
||||
(* verbose compiler output -------------------------------------------------- *)
|
||||
let verbose = ref false
|
||||
|
||||
let verb msg =
|
||||
if !verbose
|
||||
then (
|
||||
print_string msg ;
|
||||
flush Stdlib.stdout )
|
||||
|
||||
|
||||
let verb_os () =
|
||||
verb
|
||||
@@ Printf.sprintf
|
||||
"* PLATFORM: %s TRIPLE: %s FLAGS %s\n"
|
||||
os
|
||||
!target_triple
|
||||
!platform_flags
|
||||
|
||||
|
||||
let enable_verbose () =
|
||||
verbose := true ;
|
||||
verb_os ()
|
||||
|
||||
|
||||
(* create the output directory, which is assumed to exist *)
|
||||
let create_output_dir () =
|
||||
try ignore (stat !output_path) with
|
||||
| Unix_error (ENOENT, _, _) ->
|
||||
verb @@ Printf.sprintf "creating output directory: %s\n" !output_path ;
|
||||
mkdir !output_path 0o755
|
||||
|
||||
|
||||
(* clang invocation stuff --------------------------------------------------- *)
|
||||
let common_flags = "-Wno-override-module"
|
||||
|
||||
let link_flags = "-Wno-unused-command-line-argument -mstackrealign"
|
||||
|
||||
let clang_ll_mode = "-S"
|
||||
|
||||
let as_mode = "-c"
|
||||
|
||||
let rosetta_prefix = "arch -x86_64 "
|
||||
|
||||
let prefix = if cpu = "arm64" then rosetta_prefix else ""
|
||||
|
||||
let opt_level = ref "-O1 -Wall"
|
||||
|
||||
let clang args = Printf.sprintf "%sclang %s -o " prefix (String.concat " " args)
|
||||
|
||||
let clang_cmd () =
|
||||
clang [ clang_ll_mode; !opt_level; common_flags; !platform_flags ]
|
||||
|
||||
|
||||
let as_cmd () = clang [ as_mode; !opt_level; common_flags; !platform_flags ]
|
||||
|
||||
let link_cmd () = clang [ common_flags; !opt_level; !platform_flags; link_flags ]
|
||||
|
||||
(* filename munging --------------------------------------------------------- *)
|
||||
let path_to_basename_ext (path : string) : string * string =
|
||||
(* The path is of the form ... "foo/bar/baz/<file>.ext" *)
|
||||
let paths = Str.split (Str.regexp_string path_sep) path in
|
||||
let _ =
|
||||
if List.length paths = 0 then failwith @@ sprintf "bad path: %s" path
|
||||
in
|
||||
let filename = List.hd (List.rev paths) in
|
||||
match Str.split (Str.regexp_string ".") filename with
|
||||
| [ root ] ->
|
||||
(root, "")
|
||||
| [ root; ext ] ->
|
||||
(root, ext)
|
||||
| _ ->
|
||||
failwith @@ sprintf "bad filename: %s" filename
|
||||
|
||||
|
||||
(* compilation and shell commands-------------------------------------------- *)
|
||||
|
||||
(* Platform independent shell command *)
|
||||
let sh (cmd : string) (ret : string -> int -> 'a) : 'a =
|
||||
verb (sprintf "* %s\n" cmd) ;
|
||||
match system cmd with
|
||||
| WEXITED i ->
|
||||
ret cmd i
|
||||
| WSIGNALED i ->
|
||||
raise (PlatformError (cmd, sprintf "Signaled with %d." i))
|
||||
| WSTOPPED i ->
|
||||
raise (PlatformError (cmd, sprintf "Stopped with %d." i))
|
||||
|
||||
(* Platform independent shell command with a timeout (in seconds) *)
|
||||
let timeout_sh (time: int)(cmd : string) (ret : string -> int -> 'a) : 'a =
|
||||
let timeout_cmd = sprintf "%s/timeout3 -t %d %s" bin_path time cmd in
|
||||
verb (sprintf "* %s\n" timeout_cmd) ;
|
||||
match system timeout_cmd with
|
||||
| WEXITED i ->
|
||||
ret cmd i
|
||||
| WSIGNALED i ->
|
||||
if i == Sys.sigterm
|
||||
then raise (PlatformError (cmd, sprintf "Timed-out after %d s" time))
|
||||
else raise (PlatformError (cmd, sprintf "Signaled with %d." i))
|
||||
| WSTOPPED i ->
|
||||
raise (PlatformError (cmd, sprintf "Stopped with %d." i))
|
||||
|
||||
|
||||
(* Generate a file name that does not already exist.
|
||||
basedir includes the path separator
|
||||
*)
|
||||
let gen_name (basedir : string) (basen : string) (baseext : string) : string =
|
||||
let rec nocollide ofs =
|
||||
let nfn =
|
||||
sprintf
|
||||
"%s/%s%s%s"
|
||||
basedir
|
||||
basen
|
||||
(if ofs = 0 then "" else "_" ^ string_of_int ofs)
|
||||
baseext
|
||||
in
|
||||
try
|
||||
ignore (stat nfn) ;
|
||||
nocollide (ofs + 1)
|
||||
with
|
||||
| Unix_error (ENOENT, _, _) ->
|
||||
nfn
|
||||
in
|
||||
nocollide 0
|
||||
|
||||
|
||||
let raise_error cmd i =
|
||||
if i <> 0 then raise (PlatformError (cmd, sprintf "Exited with status %d." i))
|
||||
|
||||
|
||||
let ignore_error _ _ = ()
|
||||
|
||||
let preprocess (dot_oat : string) (dot_i : string) : unit =
|
||||
sh
|
||||
(sprintf
|
||||
"%s%s %s %s"
|
||||
!pp_cmd
|
||||
(List.fold_left (fun s i -> s ^ " -I" ^ i) "" !include_paths)
|
||||
dot_oat
|
||||
dot_i)
|
||||
raise_error
|
||||
|
||||
|
||||
let clang_compile (dot_ll : string) (dot_s : string) : unit =
|
||||
sh (sprintf "%s%s %s" (clang_cmd ()) dot_s dot_ll) raise_error
|
||||
|
||||
|
||||
let assemble (dot_s : string) (dot_o : string) : unit =
|
||||
sh (sprintf "%s%s %s" (as_cmd ()) dot_o dot_s) raise_error
|
||||
|
||||
|
||||
let link (mods : string list) (out_fn : string) : unit =
|
||||
sh
|
||||
(sprintf
|
||||
"%s%s %s %s %s %s"
|
||||
(link_cmd ())
|
||||
out_fn
|
||||
(String.concat " " (mods @ !lib_paths))
|
||||
(List.fold_left (fun s i -> s ^ " -L" ^ i) "" !lib_search_paths)
|
||||
(List.fold_left (fun s i -> s ^ " -I" ^ i) "" !include_paths)
|
||||
(List.fold_left (fun s l -> s ^ " -l" ^ l) "" !libs))
|
||||
raise_error
|
||||
56
hw1/lib/util/range.ml
Normal file
56
hw1/lib/util/range.ml
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
open Lexing
|
||||
|
||||
type pos = int * int (* Line number and column *)
|
||||
|
||||
type t = string * pos * pos
|
||||
|
||||
let line_of_pos (l, _) = l
|
||||
|
||||
let col_of_pos (_, c) = c
|
||||
|
||||
let mk_pos line col = (line, col)
|
||||
|
||||
let file_of_range (f, _, _) = f
|
||||
|
||||
let start_of_range (_, s, _) = s
|
||||
|
||||
let end_of_range (_, _, e) = e
|
||||
|
||||
let mk_range f s e = (f, s, e)
|
||||
|
||||
let valid_pos (l, c) = l >= 0 && c >= 0
|
||||
|
||||
let merge_range ((f, s1, e1) as r1) ((f', s2, e2) as r2) =
|
||||
if f <> f'
|
||||
then
|
||||
failwith
|
||||
@@ Printf.sprintf "merge_range called on different files: %s and %s" f f'
|
||||
else if not (valid_pos s1)
|
||||
then r2
|
||||
else if not (valid_pos s2)
|
||||
then r1
|
||||
else mk_range f (min s1 s2) (max e1 e2)
|
||||
|
||||
|
||||
let string_of_range (f, (sl, sc), (el, ec)) =
|
||||
Printf.sprintf "%s:[%d.%d-%d.%d]" f sl sc el ec
|
||||
|
||||
|
||||
let ml_string_of_range (f, (sl, sc), (el, ec)) =
|
||||
Printf.sprintf "(\"%s\", (%d, %d), (%d, %d))" f sl sc el ec
|
||||
|
||||
|
||||
let norange = ("__internal", (0, 0), (0, 0))
|
||||
|
||||
(* Creates a Range.pos from the Lexing.position data *)
|
||||
let pos_of_lexpos (p : position) : pos =
|
||||
mk_pos p.pos_lnum (p.pos_cnum - p.pos_bol)
|
||||
|
||||
|
||||
let mk_lex_range (p1 : position) (p2 : position) : t =
|
||||
mk_range p1.pos_fname (pos_of_lexpos p1) (pos_of_lexpos p2)
|
||||
|
||||
|
||||
(* Expose the lexer state as a Range.t value *)
|
||||
let lex_range lexbuf : t =
|
||||
mk_lex_range (lexeme_start_p lexbuf) (lexeme_end_p lexbuf)
|
||||
53
hw1/lib/util/range.mli
Normal file
53
hw1/lib/util/range.mli
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
(* Ranges and utilities on ranges. *)
|
||||
|
||||
(* A range represents a segment of text in a given file; it has a
|
||||
* beginning and ending position specified in terms of line and column
|
||||
* numbers. A range is associated with tokens during lexing to allow
|
||||
* the compiler to give better error messages during lexing and
|
||||
* parsing.
|
||||
*)
|
||||
|
||||
(* a position in the source file; line number and column *)
|
||||
type pos = int * int
|
||||
|
||||
(* a range of positions in a particular file *)
|
||||
type t = string * pos * pos
|
||||
|
||||
(* line of position *)
|
||||
val line_of_pos : pos -> int
|
||||
|
||||
(* column of position *)
|
||||
val col_of_pos : pos -> int
|
||||
|
||||
(* new position with given line and col *)
|
||||
val mk_pos : int -> int -> pos
|
||||
|
||||
(* the filename a range is in *)
|
||||
val file_of_range : t -> string
|
||||
|
||||
(* the beginning of the range *)
|
||||
val start_of_range : t -> pos
|
||||
|
||||
(* the end of the range *)
|
||||
val end_of_range : t -> pos
|
||||
|
||||
(* create a new range from the given filename and start, end positions *)
|
||||
val mk_range : string -> pos -> pos -> t
|
||||
|
||||
(* merge two ranges together *)
|
||||
val merge_range : t -> t -> t
|
||||
|
||||
(* pretty-print a range *)
|
||||
val string_of_range : t -> string
|
||||
|
||||
(* print a range as an ocaml value *)
|
||||
val ml_string_of_range : t -> string
|
||||
|
||||
(* use to tag generated AST nodes where range does not apply *)
|
||||
val norange : t
|
||||
|
||||
val pos_of_lexpos : Lexing.position -> pos
|
||||
|
||||
val mk_lex_range : Lexing.position -> Lexing.position -> t
|
||||
|
||||
val lex_range : Lexing.lexbuf -> t
|
||||
Loading…
Add table
Add a link
Reference in a new issue