From b10fca5e2789cea10f5f8296ec68bcae7bbd2190 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:17:34 +0300 Subject: [PATCH 01/24] Add parser --- slarnML/.gitignore | 6 + slarnML/.ocamlformat | 3 + slarnML/Makefile | 23 ++ slarnML/dune-project | 33 ++ slarnML/lib/dune | 31 ++ slarnML/lib/parser/ast.ml | 40 ++ slarnML/lib/parser/parser.ml | 697 ++++++++++++++++++++++++++++++++++ slarnML/lib/parser/parser.mli | 7 + slarnML/lib/res.ml | 13 + slarnML/slarnML.opam | 38 ++ 10 files changed, 891 insertions(+) create mode 100644 slarnML/.gitignore create mode 100644 slarnML/.ocamlformat create mode 100644 slarnML/Makefile create mode 100644 slarnML/dune-project create mode 100644 slarnML/lib/dune create mode 100644 slarnML/lib/parser/ast.ml create mode 100644 slarnML/lib/parser/parser.ml create mode 100644 slarnML/lib/parser/parser.mli create mode 100644 slarnML/lib/res.ml create mode 100644 slarnML/slarnML.opam diff --git a/slarnML/.gitignore b/slarnML/.gitignore new file mode 100644 index 000000000..b814c5756 --- /dev/null +++ b/slarnML/.gitignore @@ -0,0 +1,6 @@ +.vscode +_build +trash + +*.o +*.out diff --git a/slarnML/.ocamlformat b/slarnML/.ocamlformat new file mode 100644 index 000000000..b0368510d --- /dev/null +++ b/slarnML/.ocamlformat @@ -0,0 +1,3 @@ +profile=janestreet +sequence-style=terminator +max-indent=2 \ No newline at end of file diff --git a/slarnML/Makefile b/slarnML/Makefile new file mode 100644 index 000000000..3c10647e9 --- /dev/null +++ b/slarnML/Makefile @@ -0,0 +1,23 @@ +.PHONY: repl tests test fmt lint celan + +all: + dune build + +repl: + dune build ./slarn.exe && rlwrap _build/default/slarn.exe + +test: + dune runtest + +clean: + @$(RM) -r _build + +fmt: + dune build @fmt --auto-promote + +lint: + dune build @lint --force + +release: + dune build --profile=release + dune runtest --profile=release diff --git a/slarnML/dune-project b/slarnML/dune-project new file mode 100644 index 000000000..ac66c2f54 --- /dev/null +++ b/slarnML/dune-project @@ -0,0 +1,33 @@ +(lang dune 2.9) + +(name slarnML) + +(generate_opam_files true) + +(cram enable) + +(license LGPL-3.0-or-later) + +(source + (github ioannessh/comp23hw)) + +(authors "Ivan Shurenkov") + +(maintainers "Ivan Shurenkov") + +(package + (name slarnML) + (synopsis "SlarnML") + (version 0.0) + (depends + ocaml + dune + angstrom + base + (ppx_inline_test :with-test) + ppx_expect + ppx_deriving + bisect_ppx + (odoc :with-doc) + (ocamlformat :build))) + diff --git a/slarnML/lib/dune b/slarnML/lib/dune new file mode 100644 index 000000000..9a58f2f6c --- /dev/null +++ b/slarnML/lib/dune @@ -0,0 +1,31 @@ +(library + (name slarnML_lib) + (public_name slarnML.lib) + (modules + Res + Pprint_ast + Pprint_cc + Pprint_ll + Pprint_anf + Pprint_riscv + Ast + Parser + Typedtree + Quick_check ; Inferencer + Cc_ast + Clos_conv + Ll_ast + Lambda_lifting + Anf_ast + Anf_conv + Anf_test + Riscv_ast + Call_define + Riscv + Pprint) + (libraries base angstrom) ; llvm) + (preprocess + (pps ppx_expect ppx_inline_test)) + (inline_tests)) + +(include_subdirs unqualified) diff --git a/slarnML/lib/parser/ast.ml b/slarnML/lib/parser/ast.ml new file mode 100644 index 000000000..41e43cb48 --- /dev/null +++ b/slarnML/lib/parser/ast.ml @@ -0,0 +1,40 @@ +(** Copyright 2023-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +type const = + | CInt of int + | CBool of bool + | CUnit +[@@deriving show { with_path = false }] + +type args = string list [@@deriving show { with_path = false }] + +type decl = + | DeclRec of string * args + | Decl of string * args +[@@deriving show { with_path = false }] + +type expr = + | Id of string + | Const of const + | Not of expr (* not expr *) + | Or of expr * expr (* expr || expr *) + | And of expr * expr (* expr && expr *) + | Eq of expr * expr (* expr = expr *) + | Gt of expr * expr (* expr > expr *) + | Lt of expr * expr (* expr < expr *) + | Gte of expr * expr (* expr >= expr *) + | Lte of expr * expr (* expr <= expr *) + | Add of expr * expr (* expr + expr *) + | Sub of expr * expr (* expr - expr *) + | Mul of expr * expr (* expr * expr *) + | Div of expr * expr (* expr / expr *) + | If of expr * expr * expr (* if expr then expr else expr *) + | Let of decl * expr (* let id arg1 arg2 = expr *) + | LetIn of decl * expr * expr (* let id arg1 arg2 = expr in expr *) + | Fun of args * expr (* fun arg1 arg2 -> expr *) + | App of expr * expr list +[@@deriving show { with_path = false }] + +type ast = expr list [@@deriving show { with_path = false }] diff --git a/slarnML/lib/parser/parser.ml b/slarnML/lib/parser/parser.ml new file mode 100644 index 000000000..b6331b14d --- /dev/null +++ b/slarnML/lib/parser/parser.ml @@ -0,0 +1,697 @@ +(** Copyright 2023-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Angstrom +open Ast + +let is_whitespace = function + | ' ' -> true + | _ -> false +;; + +let is_tab = function + | '\t' -> true + | _ -> false +;; + +let is_newline = function + | '\n' | '\r' -> true + | _ -> false +;; + +let is_empty_char c = is_tab c || is_whitespace c || is_newline c + +let is_digit = function + | '0' .. '9' -> true + | _ -> false +;; + +let is_letter = function + | 'a' .. 'z' | 'A' .. 'Z' -> true + | _ -> false +;; + +let is_keyword = function + | "fun" | "let" | "in" | "if" | "then" | "else" | "true" | "false" | "not" | "rec" -> + true + | _ -> false +;; + +let skip_empty = skip_while is_empty_char +let take_empty1 = take_while1 is_empty_char +let parens p = char '(' *> p <* char ')' + +let integer = + let minus = skip_empty *> string "-" *> return (-1) in + (* let plus = skip_empty *> (string "+" <|> string "") *> return 1 in *) + let number sign = + skip_empty *> take_while1 is_digit + >>= fun num -> return (CInt (sign * int_of_string num)) + in + (* (minus <|> plus) >>= number *) + number 1 <|> skip_empty *> parens (minus >>= number <* skip_empty) +;; + +let boolean1 = + let true_w = take_empty1 *> string "true" *> return (CBool true) in + let false_w = take_empty1 *> string "false" *> return (CBool false) in + true_w <|> false_w +;; + +let boolean = + let true_w = skip_empty *> string "true" *> return (CBool true) in + let false_w = skip_empty *> string "false" *> return (CBool false) in + true_w <|> false_w +;; + +let unit_c = parens @@ (string "" *> return CUnit) + +let identifier = + let word = + skip_empty *> take_while1 (fun c -> Char.equal c '_' || is_digit c || is_letter c) + in + let checker word = + if is_digit (String.get word 0) || is_keyword word + then fail "Not correct identifier" + else return word + in + word >>= checker +;; + +let tuple el = + skip_empty + *> parens + (lift2 + (fun lst el -> List.concat [ lst; [ el ] ]) + (many (el <* skip_empty <* char ',')) + (el <* skip_empty)) +;; + +let arguments = tuple identifier <|> many identifier +let arguments1 = tuple identifier <|> many1 identifier + +let declaration is_rec = + skip_empty *> identifier + >>= fun id -> + skip_empty *> arguments + >>= fun arg_lst -> + if is_rec then return (DeclRec (id, arg_lst)) else return (Decl (id, arg_lst)) +;; + +let add = skip_empty *> char '+' *> return (fun e1 e2 -> Add (e1, e2)) +let sub = skip_empty *> char '-' *> return (fun e1 e2 -> Sub (e1, e2)) +let mul = skip_empty *> char '*' *> return (fun e1 e2 -> Mul (e1, e2)) +let div = skip_empty *> char '/' *> return (fun e1 e2 -> Div (e1, e2)) +let and_o = skip_empty *> string "&&" *> return (fun e1 e2 -> And (e1, e2)) +let or_o = skip_empty *> string "||" *> return (fun e1 e2 -> Or (e1, e2)) + +let not_op = + let is_parens = + peek_char_fail + >>= function + | '(' -> return "" + | _ -> take_empty1 + in + let not_o = (skip_empty *> string "not" <* is_parens) *> return (fun e -> Not e) in + let empty_o = skip_empty *> return (fun e -> e) in + not_o <|> empty_o +;; + +let compare_op = + let gt = skip_empty *> string ">" *> return (fun e1 e2 -> Gt (e1, e2)) in + let lt = skip_empty *> string "<" *> return (fun e1 e2 -> Lt (e1, e2)) in + let gte = skip_empty *> string ">=" *> return (fun e1 e2 -> Gte (e1, e2)) in + let lte = skip_empty *> string "<=" *> return (fun e1 e2 -> Lte (e1, e2)) in + let eq = skip_empty *> string "=" *> return (fun e1 e2 -> Eq (e1, e2)) in + let neq = + skip_empty *> (string "<>" <|> string "!=") *> return (fun e1 e2 -> Not (Eq (e1, e2))) + in + eq <|> neq <|> gte <|> lte <|> gt <|> lt +;; + +let chainl1 e op = + let rec go acc = lift2 (fun f x -> f acc x) op e >>= go <|> return acc in + e >>= fun init -> go init +;; + +let identifier_expr = identifier >>= fun id -> return @@ Id id + +let parse_math id_f = + fix (fun expr -> + let not_e ex = not_op >>= fun f -> lift f ex in + let integer_e = integer >>= fun c -> return @@ Const c in + let id_e = id_f in + let bool_e = boolean >>= fun b -> return @@ Const b in + let factor = + skip_empty *> parens expr + <|> bool_e + <|> integer_e + <|> parens id_e + <|> identifier_expr + in + let term = not_e factor in + let term = chainl1 term (mul <|> div) in + let term = chainl1 term (add <|> sub) in + let term = chainl1 term compare_op in + let term = chainl1 term and_o in + let term = chainl1 term or_o in + term <* skip_empty) +;; + +let parse_expr = + fix (fun expr -> + let unit_e = unit_c >>= fun c -> return @@ Const c in + let if_ex = + let if_e ex = (skip_empty *> string "if" <* take_empty1) *> ex in + let then_e ex = (skip_empty *> string "then" <* take_empty1) *> ex in + let else_e ex = (skip_empty *> string "else" <* take_empty1) *> ex in + lift3 + (fun i t e -> If (i, t, e)) + (if_e expr) + (then_e expr) + (else_e expr <|> return (Const CUnit)) + in + let let_ex = + let let_d = (skip_empty *> string "let" <* take_empty1) *> declaration false in + let let_rd = + (skip_empty *> string "let" *> take_empty1 *> string "rec" <* take_empty1) + *> declaration true + in + let eq_e ex = skip_empty *> string "=" *> ex in + lift2 (fun le eq -> Let (le, eq)) (let_rd <|> let_d) (eq_e expr) + in + let let_in_ex = + let let_d = (skip_empty *> string "let" <* take_empty1) *> declaration false in + let let_rd = + (skip_empty *> string "let" *> take_empty1 *> string "rec" <* take_empty1) + *> declaration true + in + let eq_e ex = skip_empty *> string "=" *> ex in + let in_e ex = (skip_empty *> string "in" <* take_empty1) *> ex in + lift3 (fun le eq i -> LetIn (le, eq, i)) (let_rd <|> let_d) (eq_e expr) (in_e expr) + in + let fun_ex e = + let fun_a = (skip_empty *> string "fun" <* take_empty1) *> arguments1 in + let arrow_e ex = skip_empty *> string "->" *> ex in + lift2 (fun a f -> Fun (a, f)) fun_a (arrow_e e) + in + let app_ex e = + let args_app = many1 @@ (parens @@ fun_ex e <|> e) in + let id = skip_empty *> (parens @@ fun_ex e) <|> identifier_expr in + let args = skip_empty *> args_app in + lift2 (fun id args -> App (id, args)) id args + in + let parse_math2 = + fix (fun m_expr -> + let not_e ex = not_op >>= fun f -> lift f ex in + let integer_e = integer >>= fun c -> return @@ Const c in + let bool_e = boolean >>= fun b -> return @@ Const b in + let factor = + take_empty1 *> m_expr + <|> parens m_expr + <|> bool_e + <|> integer_e + <|> parens @@ app_ex m_expr + <|> parens @@ fun_ex expr + <|> identifier_expr + in + let term = not_e factor in + let term = chainl1 term (mul <|> div) in + let term = chainl1 term (add <|> sub) in + let term = chainl1 term compare_op in + let term = chainl1 term and_o in + let term = chainl1 term or_o in + term <* skip_empty) + in + take_empty1 *> expr + <|> parens expr + <|> let_in_ex + <|> let_ex + <|> if_ex + <|> parse_math2 + <|> app_ex expr + <|> fun_ex expr + <|> unit_e + (* <|> (parse_math identifier_expr) *)) +;; + +let parse_exprs = many (parse_expr <* (string ";;" <|> string "")) <* skip_empty +let parser str = parse_string ~consume:Consume.All parse_exprs str + +(*=============================*) +(*============TESTS============*) +(*=============================*) + +let test_ok parser input expected = + match parse_string ~consume:Consume.All parser input with + | Ok res when res = expected -> true + | Ok _ -> + Printf.printf "%s\n" input; + false + | Error e -> + Printf.printf "%s\n" e; + false +;; + +let test_fail parser input = + match parse_string ~consume:Consume.All parser input with + | Ok _ -> + Printf.printf "%s\n" input; + false + | Error _ -> true +;; + +(*== Test parse integer ==*) +let parse_ok = test_ok integer +let parse_fail = test_fail integer +let%test _ = parse_ok " 1" (CInt 1) +let%test _ = parse_ok " (-1234567890)" (CInt (-1234567890)) +let%test _ = parse_ok " 0901" (CInt 901) +let%test _ = parse_ok "( - 0001000 )" (CInt (-1000)) +let%test _ = parse_fail "" +let%test _ = parse_fail "aa" +let%test _ = parse_fail " " + +(*== Test parse boolean ==*) +let parse_ok = test_ok boolean1 +let parse_fail = test_fail boolean1 +let%test _ = parse_ok " true" (CBool true) +let%test _ = parse_ok " false" (CBool false) +let%test _ = parse_fail "1" +let%test _ = parse_fail "aa" +let%test _ = parse_fail " " +let%test _ = parse_fail "" + +(*== Test parse identifier ==*) +let parse_ok = test_ok identifier +let parse_fail = test_fail identifier +let%test _ = parse_ok " _" "_" +let%test _ = parse_ok " a" "a" + +let%test _ = + parse_ok "qwertyuiopasdfghjklzxcvbnm1234567890_" "qwertyuiopasdfghjklzxcvbnm1234567890_" +;; + +let%test _ = parse_ok "true_" "true_" +let%test _ = parse_ok "false_" "false_" +let%test _ = parse_ok "fun_" "fun_" +let%test _ = parse_ok "let_" "let_" +let%test _ = parse_ok "if_" "if_" +let%test _ = parse_ok "then_" "then_" +let%test _ = parse_ok "else_" "else_" +let%test _ = parse_ok "in_" "in_" +let%test _ = parse_ok "not_" "not_" +let%test _ = parse_ok "rec_" "rec_" +let%test _ = parse_fail "1" +let%test _ = parse_fail "1a" +let%test _ = parse_fail "true" +let%test _ = parse_fail "false" +let%test _ = parse_fail "fun" +let%test _ = parse_fail "let" +let%test _ = parse_fail "if" +let%test _ = parse_fail "then" +let%test _ = parse_fail "else" +let%test _ = parse_fail "in" +let%test _ = parse_fail "not" +let%test _ = parse_fail "rec" +let%test _ = parse_fail " " +let%test _ = parse_fail "" + +(*== Test parse tuple ==*) +let common_tuple = + let constant_e = boolean <|> integer <|> unit_c >>= fun c -> return @@ Const c in + let identifier_e = identifier >>= fun id -> return @@ Id id in + let tuple_el = skip_empty *> (constant_e <|> identifier_e) in + tuple tuple_el +;; + +let parse_ok = test_ok common_tuple +let parse_fail = test_fail common_tuple +let%test _ = parse_ok "(())" [ Const CUnit ] +let%test _ = parse_ok "(true)" [ Const (CBool true) ] +let%test _ = parse_ok "(1)" [ Const (CInt 1) ] +let%test _ = parse_ok "(a)" [ Id "a" ] +let%test _ = parse_ok " ( a )" [ Id "a" ] +let%test _ = parse_ok "(a, b)" [ Id "a"; Id "b" ] +let%test _ = parse_ok " ( a , b )" [ Id "a"; Id "b" ] +let%test _ = parse_fail "(a b)" +let%test _ = parse_fail "(a, )" +let%test _ = parse_fail "()" + +(*== Test parse argiments ==*) +(* TODO: arguments can accept Const(CUnit, CInt, CBool) and Id(string) *) + +let parse_ok = test_ok arguments +let parse_fail = test_fail arguments +let%test _ = parse_ok " _" [ "_" ] +let%test _ = parse_ok " _ _" [ "_"; "_" ] +let%test _ = parse_ok "a b" [ "a"; "b" ] +let%test _ = parse_ok "" [] +let%test _ = parse_ok "(a)" [ "a" ] +let%test _ = parse_ok "(a, b)" [ "a"; "b" ] +let%test _ = parse_fail "(a b)" +let%test _ = parse_fail "(a, )" +let%test _ = parse_fail "()" + +(*== Test parse declaration ==*) +let parse_ok flag = test_ok @@ declaration flag +let parse_fail flag = test_fail @@ declaration flag +let%test _ = parse_ok true "_" (DeclRec ("_", [])) +let%test _ = parse_ok false "a" (Decl ("a", [])) +let%test _ = parse_ok true "a b c" (DeclRec ("a", [ "b"; "c" ])) +let%test _ = parse_ok false "a b c" (Decl ("a", [ "b"; "c" ])) +let%test _ = parse_fail true "" +let%test _ = parse_fail false "" + +(*== Test parse math operations ==*) +let parse_ok = test_ok (parse_math identifier_expr) +let parse_fail = test_fail (parse_math identifier_expr) +let%test _ = parse_ok " ( a )" (Id "a") +let%test _ = parse_ok " a" (Id "a") +let%test _ = parse_ok "(a)" (Id "a") +let%test _ = parse_ok " (1)" (Const (CInt 1)) +let%test _ = parse_ok " 1" (Const (CInt 1)) +let%test _ = parse_ok "(1)" (Const (CInt 1)) +let%test _ = parse_ok " a + 2" (Add (Id "a", Const (CInt 2))) +let%test _ = parse_ok " a - 2" (Sub (Id "a", Const (CInt 2))) +let%test _ = parse_ok " a * 2" (Mul (Id "a", Const (CInt 2))) +let%test _ = parse_ok " a / 2" (Div (Id "a", Const (CInt 2))) +let%test _ = parse_ok " not a" (Not (Id "a")) +let%test _ = parse_ok " not (a)" (Not (Id "a")) +let%test _ = parse_ok "not(a)" (Not (Id "a")) +let%test _ = parse_ok " a && b" (And (Id "a", Id "b")) +let%test _ = parse_ok " a || b" (Or (Id "a", Id "b")) +let%test _ = parse_ok " a = b" (Eq (Id "a", Id "b")) +let%test _ = parse_ok " a != b" (Not (Eq (Id "a", Id "b"))) +let%test _ = parse_ok " a <> b" (Not (Eq (Id "a", Id "b"))) +let%test _ = parse_ok " not (a = b)" (Not (Eq (Id "a", Id "b"))) +let%test _ = parse_ok " a > b" (Gt (Id "a", Id "b")) +let%test _ = parse_ok " a >= b" (Gte (Id "a", Id "b")) +let%test _ = parse_ok " a < b" (Lt (Id "a", Id "b")) +let%test _ = parse_ok " a <= b" (Lte (Id "a", Id "b")) + +(*Test parse math priority*) +let%test _ = parse_ok " a - 2+b" (Add (Sub (Id "a", Const (CInt 2)), Id "b")) +let%test _ = parse_ok " a + 2-b" (Sub (Add (Id "a", Const (CInt 2)), Id "b")) +let%test _ = parse_ok " a + 2*b" (Add (Id "a", Mul (Const (CInt 2), Id "b"))) +let%test _ = parse_ok " a / 2*b" (Mul (Div (Id "a", Const (CInt 2)), Id "b")) +let%test _ = parse_ok "\n\n a*2/b" (Div (Mul (Id "a", Const (CInt 2)), Id "b")) +let%test _ = parse_ok " (a + 2)*b" (Mul (Add (Id "a", Const (CInt 2)), Id "b")) + +let%test _ = + parse_ok " not(not (a) + 2)*b" (Mul (Not (Add (Not (Id "a"), Const (CInt 2))), Id "b")) +;; + +let%test _ = + parse_ok + " not(not((a+(3/2-1)))+2)*b" + (Mul + ( Not + (Add + ( Not + (Add (Id "a", Sub (Div (Const (CInt 3), Const (CInt 2)), Const (CInt 1)))) + , Const (CInt 2) )) + , Id "b" )) +;; + +let%test _ = + parse_ok + " a + 2 = b * 3" + (Eq (Add (Id "a", Const (CInt 2)), Mul (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + " a \n+ 2 > b * 3" + (Gt (Add (Id "a", Const (CInt 2)), Mul (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + " a + 2\n >= b * 3" + (Gte (Add (Id "a", Const (CInt 2)), Mul (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + " a + 2 != b * 3" + (Not (Eq (Add (Id "a", Const (CInt 2)), Mul (Id "b", Const (CInt 3))))) +;; + +let%test _ = + parse_ok + " a + 2 < b \t* 3" + (Lt (Add (Id "a", Const (CInt 2)), Mul (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + " a + 2 \n\n<= b * 3" + (Lte (Add (Id "a", Const (CInt 2)), Mul (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + " a < 2 && b = 3" + (And (Lt (Id "a", Const (CInt 2)), Eq (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + " a < 2 || b = 3" + (Or (Lt (Id "a", Const (CInt 2)), Eq (Id "b", Const (CInt 3)))) +;; + +let%test _ = parse_ok "a && b||c" (Or (And (Id "a", Id "b"), Id "c")) +let%test _ = parse_fail "(a && b||c" +let%test _ = parse_fail "a + " +let%test _ = parse_fail " + " +let%test _ = parse_fail " + a" +let%test _ = parse_fail "not" +let%test _ = parse_fail "a && b||c)" + +(*== Test parse apply ==*) + +let parse_ok = test_ok parse_expr + +let%test _ = + parse_ok + "let c = (a 1 b w c (fun x -> x))" + (Let + ( Decl ("c", []) + , App (Id "a", [ Const (CInt 1); Id "b"; Id "w"; Id "c"; Fun ([ "x" ], Id "x") ]) + )) +;; + +(* let parse_ok_anon = test_ok (parse_expr) *) +(* let%test _ = parse_ok_anon "(fun x -> x)" (Fun(["x"], Id "x")) *) + +(*== Test parse common expretion ==*) +let parse_ok = test_ok parse_expr +let parse_fail = test_fail parse_expr + +let%test _ = + parse_ok + " a + 2 \n\n<= b * 3" + (Lte (Add (Id "a", Const (CInt 2)), Mul (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + "a < 2 && b = 3" + (And (Lt (Id "a", Const (CInt 2)), Eq (Id "b", Const (CInt 3)))) +;; + +let%test _ = + parse_ok + " a < 2 || b = 3" + (Or (Lt (Id "a", Const (CInt 2)), Eq (Id "b", Const (CInt 3)))) +;; + +let%test _ = parse_ok " a && b||c" (Or (And (Id "a", Id "b"), Id "c")) + +(* let%test _ = parse_ok "(a b) * 3 + (b 1 (a f 2) (1 + a))" (Id "") *) +let%test _ = + parse_ok + "(a b 2 1+3 * b d (-2) (r f)) + 3" + (Add + ( App + ( Id "a" + , [ Id "b" + ; Const (CInt 2) + ; Add (Const (CInt 1), Mul (Const (CInt 3), Id "b")) + ; Id "d" + ; Const (CInt (-2)) + ; App (Id "r", [ Id "f" ]) + ] ) + , Const (CInt 3) )) +;; + +let%test _ = + parse_ok + "a + (f 2 x) * 3" + (Add (Id "a", Mul (App (Id "f", [ Const (CInt 2); Id "x" ]), Const (CInt 3)))) +;; + +let%test _ = + parse_ok + "(a + (f 2 x (g 3 y)) * 3)" + (Add + ( Id "a" + , Mul + ( App + ( Id "f" + , [ Const (CInt 2); Id "x"; App (Id "g", [ Const (CInt 3); Id "y" ]) ] ) + , Const (CInt 3) ) )) +;; + +(* (a + (f 2 x (g (3*z) y)) * 3) - not work *) +let%test _ = + parse_ok + "(a + (f 2 x (g 3*z y)) * 3)" + (Add + ( Id "a" + , Mul + ( App + ( Id "f" + , [ Const (CInt 2) + ; Id "x" + ; App (Id "g", [ Mul (Const (CInt 3), Id "z"); Id "y" ]) + ] ) + , Const (CInt 3) ) )) +;; + +let%test _ = + parse_ok + "true && (a + (f false (g 3 y)) = 3 || 2)" + (And + ( Const (CBool true) + , Or + ( Eq + ( Add + ( Id "a" + , App + ( Id "f" + , [ Const (CBool false); App (Id "g", [ Const (CInt 3); Id "y" ]) ] + ) ) + , Const (CInt 3) ) + , Const (CInt 2) ) )) +;; + +let%test _ = parse_ok "()" (Const CUnit) +let%test _ = parse_ok "fun \n( a , c ) -> b" (Fun ([ "a"; "c" ], Id "b")) +let%test _ = parse_ok "(fun a -> b)" (Fun ([ "a" ], Id "b")) +let%test _ = parse_ok "let a (c, d) = (b)" (Let (Decl ("a", [ "c"; "d" ]), Id "b")) +let%test _ = parse_ok "fun (a, b) -> c" (Fun ([ "a"; "b" ], Id "c")) +let%test _ = parse_ok " let rec a = ()" (Let (DeclRec ("a", []), Const CUnit)) +let%test _ = parse_ok "let a = (b) in c" (LetIn (Decl ("a", []), Id "b", Id "c")) +let%test _ = parse_ok "\nlet rec a = b in (c)" (LetIn (DeclRec ("a", []), Id "b", Id "c")) +let%test _ = parse_ok "\nif a then b else c" (If (Id "a", Id "b", Id "c")) +let%test _ = parse_ok "if a then b" (If (Id "a", Id "b", Const CUnit)) +let%test _ = parse_ok "\n(let a = b)" (Let (Decl ("a", []), Id "b")) + +let%test _ = + parse_ok + "let a = \nlet b = 1 in\n\t let c = b in\n\t c" + (Let + ( Decl ("a", []) + , LetIn (Decl ("b", []), Const (CInt 1), LetIn (Decl ("c", []), Id "b", Id "c")) )) +;; + +let%test _ = + parse_ok + "let a = let b = 1 in let c = b in c" + (Let + ( Decl ("a", []) + , LetIn (Decl ("b", []), Const (CInt 1), LetIn (Decl ("c", []), Id "b", Id "c")) )) +;; + +let%test _ = parse_fail "fun -> b" +let%test _ = parse_fail "(let a = b" +let%test _ = parse_fail "let a = b)" +let%test _ = parse_fail "let = b" +let%test _ = parse_fail "let a = " +let%test _ = parse_fail "let (a) = b" +let%test _ = parse_fail "let () = b" +let%test _ = parse_fail "let rec = b" +let%test _ = parse_fail "let rec a = " +let%test _ = parse_fail "let = b in c" +let%test _ = parse_fail "let a = in c" +let%test _ = parse_fail "let a = b in " +let%test _ = parse_fail "let rec = b in c" +let%test _ = parse_fail "let rec a = in c" +let%test _ = parse_fail "let rec a = b in " +let%test _ = parse_fail "if a else b" + +(*== Test parse ==*) +let parse_ok = test_ok parse_exprs +(*let parse_fail = test_fail parse_exprs*) + +let%test _ = + parse_ok + "let a = \nlet b = 1 in\n\t let c = b in\n\t c" + [ Let + ( Decl ("a", []) + , LetIn (Decl ("b", []), Const (CInt 1), LetIn (Decl ("c", []), Id "b", Id "c")) + ) + ] +;; + +let%test _ = + parse_ok + "let a = \nlet b = 1 in\n\t let c = b in\n\t c;;" + [ Let + ( Decl ("a", []) + , LetIn (Decl ("b", []), Const (CInt 1), LetIn (Decl ("c", []), Id "b", Id "c")) + ) + ] +;; + +let%test _ = parse_ok "\n\t \n" [] +let%test _ = parse_ok "" [] + +let%test _ = + parse_ok + "let a = (b) let a = b;;" + [ Let (Decl ("a", []), Id "b"); Let (Decl ("a", []), Id "b") ] +;; + +let%test _ = + parse_ok + "let a = b;; let a c d = b" + [ Let (Decl ("a", []), Id "b"); Let (Decl ("a", [ "c"; "d" ]), Id "b") ] +;; + +let%test _ = + parse_ok + "let a = b in c;; let a = b let a = b in c" + [ LetIn (Decl ("a", []), Id "b", Id "c") + ; Let (Decl ("a", []), Id "b") + ; LetIn (Decl ("a", []), Id "b", Id "c") + ] +;; + +let%test _ = + parse_ok + "let a b c = 1;; (a b c 1 (c + 2));; let b = (a c)" + [ Let (Decl ("a", [ "b"; "c" ]), Const (CInt 1)) + ; App (Id "a", [ Id "b"; Id "c"; Const (CInt 1); Add (Id "c", Const (CInt 2)) ]) + ; Let (Decl ("b", []), App (Id "a", [ Id "c" ])) + ] +;; + +let%test _ = + parse_ok + "let a = let b = 1 in let c = 2 in (d 3)" + [ Let + ( Decl ("a", []) + , LetIn + ( Decl ("b", []) + , Const (CInt 1) + , LetIn (Decl ("c", []), Const (CInt 2), App (Id "d", [ Const (CInt 3) ])) ) + ) + ] +;; + +let%test _ = parse_fail ";;" diff --git a/slarnML/lib/parser/parser.mli b/slarnML/lib/parser/parser.mli new file mode 100644 index 000000000..4469fd9e9 --- /dev/null +++ b/slarnML/lib/parser/parser.mli @@ -0,0 +1,7 @@ +(** Copyright 2023-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Ast + +val parser : string -> (expr list, string) result diff --git a/slarnML/lib/res.ml b/slarnML/lib/res.ml new file mode 100644 index 000000000..bc53aba95 --- /dev/null +++ b/slarnML/lib/res.ml @@ -0,0 +1,13 @@ +type 'a res = + | Result of 'a + | Error of string +[@@deriving show { with_path = false }] + +let map f = function + | Result o -> f o + | Error e -> Error e +;; + +let bind r f = f r +let ( >>= ) r f = map f r +let ( |> ) = bind diff --git a/slarnML/slarnML.opam b/slarnML/slarnML.opam new file mode 100644 index 000000000..1c2cfe8e6 --- /dev/null +++ b/slarnML/slarnML.opam @@ -0,0 +1,38 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.0" +synopsis: "SlarnML" +maintainer: ["Ivan Shurenkov"] +authors: ["Ivan Shurenkov"] +license: "LGPL-3.0-or-later" +homepage: "https://github.com/ioannessh/comp23hw" +bug-reports: "https://github.com/ioannessh/comp23hw/issues" +depends: [ + "ocaml" + "dune" {>= "2.9"} + "angstrom" + "base" + "ppx_inline_test" {with-test} + "ppx_expect" + "ppx_deriving" + "bisect_ppx" + "odoc" {with-doc} + "ocamlformat" {build} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "--promote-install-files=false" + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["dune" "install" "-p" name "--create-install-files" name] +] +dev-repo: "git+https://github.com/ioannessh/comp23hw.git" From b92de8cccf68972f1bf7c2d631c1e5e965f30e1a Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:20:15 +0300 Subject: [PATCH 02/24] Add closure conversion --- slarnML/lib/anf/cc_ast.ml | 29 +++++ slarnML/lib/anf/clos_conv.ml | 214 ++++++++++++++++++++++++++++++++++ slarnML/lib/anf/clos_conv.mli | 5 + 3 files changed, 248 insertions(+) create mode 100644 slarnML/lib/anf/cc_ast.ml create mode 100644 slarnML/lib/anf/clos_conv.ml create mode 100644 slarnML/lib/anf/clos_conv.mli diff --git a/slarnML/lib/anf/cc_ast.ml b/slarnML/lib/anf/cc_ast.ml new file mode 100644 index 000000000..ac502e392 --- /dev/null +++ b/slarnML/lib/anf/cc_ast.ml @@ -0,0 +1,29 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Ast + +type c_expr = + | CId of string + | CConst of const + | CNot of c_expr + | COr of c_expr * c_expr + | CAnd of c_expr * c_expr + | CEq of c_expr * c_expr + | CGt of c_expr * c_expr + | CLt of c_expr * c_expr + | CGte of c_expr * c_expr + | CLte of c_expr * c_expr + | CAdd of c_expr * c_expr + | CSub of c_expr * c_expr + | CMul of c_expr * c_expr + | CDiv of c_expr * c_expr + | CIf of c_expr * c_expr * c_expr + | CLet of decl * c_expr + | CLetIn of decl * c_expr * c_expr + | CFun of args * c_expr (* anon fun *) + | CApp of c_expr * c_expr list +[@@deriving show { with_path = false }] + +type cc_ast = c_expr list [@@deriving show { with_path = false }] diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml new file mode 100644 index 000000000..2d5fd2f05 --- /dev/null +++ b/slarnML/lib/anf/clos_conv.ml @@ -0,0 +1,214 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Ast +open Cc_ast +open Res + +let get_ast = map (fun (ast, _, _, _, _) -> Result ast) + +let get_cc_args lvl = + map (fun (_, _, p_args, _, _) -> + let cc_args = + List.map (fun (a, _) -> a) (List.filter (fun (_, l) -> l <= lvl) p_args) + in + Result cc_args) +;; + +let get_app_args a_id res = + match res with + | Error _ -> [] + | Result (_, _, _, args, _) -> + (match a_id with + | CId id -> + (match List.find_opt (fun (i, _, _) -> i = id) args with + | None -> [] + | Some (_, args, _) -> List.map (fun a -> CId a) args) + | _ -> []) +;; + +let update_ast f = + map (fun (ast, args, p_args, app_args, funs) -> + Result (f ast, args, p_args, app_args, funs)) +;; + +let update_args c_args lvl = + map (fun (ast, args, p_args, app_args, funs) -> + Result + (ast, List.append (List.map (fun a -> a, lvl) c_args) args, p_args, app_args, funs)) +;; + +let update_app id i_args lvl = + map (fun (ast, args, p_args, app_args, funs) -> + Result (ast, args, p_args, (id, i_args, lvl) :: app_args, funs)) +;; + +let update_func f = + map (fun (ast, args, p_args, app_args, funs) -> + Result (ast, args, p_args, app_args, f funs)) +;; + +let filter lvl = + map (fun (ast, args, p_args, app_args, funs) -> + Result + ( ast + , List.filter (fun (_, l) -> lvl >= l) args + , List.filter (fun (_, l) -> lvl > l) p_args + , List.filter (fun (_, _, l) -> lvl >= l) app_args + , funs )) +;; + +let simplify_id id lvl f = + map (fun (ast, args, p_args, app_args, funs) -> + match List.find_opt (fun (a, _) -> a = id) args with + | None -> + (match List.find_opt (fun a -> a = id) funs with + | Some _ -> Result (f ast, args, p_args, app_args, funs) + | None -> Error (String.concat "" [ id; " not exist" ])) + | Some (_, l) -> + if l = lvl + then Result (f ast, args, p_args, app_args, funs) + else ( + match List.find_opt (fun (a, _) -> a = id) p_args with + | None -> Result (f ast, args, List.append p_args [ id, l ], app_args, funs) + | _ -> Result (f ast, args, p_args, app_args, funs))) +;; + +let rec simplify ast lvl f res = + let f_id _ a = a in + let simplify_bin_op f e1 e2 res = + res + |> simplify e1 lvl f_id + |> fun res1 -> + res1 + |> get_ast + >>= fun a1 -> res1 |> simplify e2 lvl f_id |> update_ast (fun a2 -> f a1 a2) + in + match ast with + | Id id -> res |> simplify_id id lvl (fun _ -> (f res) (CId id)) + | Const c -> res |> update_ast (fun _ -> CConst c) + | Not e -> res |> simplify e lvl f_id |> update_ast (fun e -> CNot e) + | Or (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> COr (e1, e2)) e1 e2 + | And (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CAnd (e1, e2)) e1 e2 + | Eq (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CEq (e1, e2)) e1 e2 + | Gt (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CGt (e1, e2)) e1 e2 + | Lt (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CLt (e1, e2)) e1 e2 + | Gte (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CGte (e1, e2)) e1 e2 + | Lte (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CLte (e1, e2)) e1 e2 + | Add (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CAdd (e1, e2)) e1 e2 + | Sub (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CSub (e1, e2)) e1 e2 + | Mul (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CMul (e1, e2)) e1 e2 + | Div (e1, e2) -> res |> simplify_bin_op (fun e1 e2 -> CDiv (e1, e2)) e1 e2 + | If (e1, e2, e3) -> + res + |> simplify e1 lvl f_id + |> fun r1 -> + r1 + |> get_ast + >>= fun a1 -> + r1 + |> simplify e2 lvl f_id + |> fun r2 -> + r2 + |> get_ast + >>= fun a2 -> r2 |> simplify e3 lvl f_id |> update_ast (fun a3 -> CIf (a1, a2, a3)) + | Let (d, e) -> + let id, args, env, dec = + match d with + | Decl (id, args) -> id, args, args, fun id args -> Decl (id, args) + | DeclRec (id, args) -> id, args, id :: args, fun id args -> DeclRec (id, args) + in + res + |> update_args env (lvl + 1) + |> simplify e (lvl + 1) f_id + |> get_cc_args lvl + >>= fun new_args -> + res + |> update_app id new_args lvl + |> update_args env (lvl + 1) + |> simplify e (lvl + 1) f_id + |> filter lvl + |> update_ast (fun a -> CLet (dec id (List.append new_args args), a)) + |> update_args [ id ] lvl + | LetIn (d, e1, e2) -> + let id, args, env, dec = + match d with + | Decl (id, args) -> id, args, args, fun id args -> Decl (id, args) + | DeclRec (id, args) -> id, args, id :: args, fun id args -> DeclRec (id, args) + in + res + |> update_args env (lvl + 1) + |> simplify e1 (lvl + 1) f_id + |> get_cc_args lvl + >>= fun new_args -> + res + |> update_app id new_args lvl + |> update_args env (lvl + 1) + |> simplify e1 (lvl + 1) f_id + |> fun r1 -> + r1 + |> get_ast + >>= fun a1 -> + r1 + |> filter lvl + |> update_args [ id ] lvl + |> simplify e2 lvl f_id + |> update_ast (fun a2 -> CLetIn (dec id (List.append new_args args), a1, a2)) + | Fun (a, e) -> + (match a with + | [] -> Error "Fun hasn't args" + | args -> + res + |> update_args args (lvl + 1) + |> simplify e (lvl + 1) f_id + |> fun r -> + r + |> get_cc_args lvl + >>= fun new_args -> + r + |> filter lvl + |> update_ast (fun a -> + CApp (CFun (List.append new_args args, a), List.map (fun a -> CId a) new_args))) + | App (func, args) -> + List.fold_left + (fun prev e -> + prev + >>= fun (ap, r) -> + Result r + |> simplify e lvl f_id + >>= fun r -> Result r |> get_ast >>= fun a -> Result (a :: ap, r)) + (res >>= fun r -> Result ([], r)) + args + >>= fun (r_args, res) -> + let args = List.rev r_args in + Result res + |> simplify func lvl (fun r a -> CApp (a, get_app_args a r)) + |> update_ast (fun a -> CApp (a, args)) +;; + +let default_res = Result (CId "Error", [], [], [], []) + +let get_func ast = + match ast with + | CLet (Decl (id, _), _) -> [ id ] + | CLetIn (Decl (id, _), _, _) -> [ id ] + | _ -> [] +;; + +let default_fun = List.map (fun (id, _) -> id) Call_define.default_func + +let clos_conv ast = + List.fold_left + (fun cc_ast ast -> + cc_ast + >>= fun (cc_ast, funs) -> + default_res + |> update_func (fun _ -> funs) + |> simplify ast 0 (fun _ a -> a) + |> get_ast + >>= fun ast -> Result (cc_ast @ [ ast ], get_func ast @ funs)) + (Result ([], default_fun)) + ast + >>= fun (ast, _) -> Result ast +;; diff --git a/slarnML/lib/anf/clos_conv.mli b/slarnML/lib/anf/clos_conv.mli new file mode 100644 index 000000000..458299049 --- /dev/null +++ b/slarnML/lib/anf/clos_conv.mli @@ -0,0 +1,5 @@ +open Ast +open Cc_ast +open Res + +val clos_conv : expr list -> c_expr list res From bdc58906ee797bb6d0a4b8d718693fff3b9691d0 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:21:47 +0300 Subject: [PATCH 03/24] Add lambda lifting --- slarnML/lib/anf/lambda_lifting.ml | 164 +++++++++++++++++++++++++++++ slarnML/lib/anf/lambda_lifting.mli | 5 + slarnML/lib/anf/ll_ast.ml | 25 +++++ 3 files changed, 194 insertions(+) create mode 100644 slarnML/lib/anf/lambda_lifting.ml create mode 100644 slarnML/lib/anf/lambda_lifting.mli create mode 100644 slarnML/lib/anf/ll_ast.ml diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml new file mode 100644 index 000000000..49fc50973 --- /dev/null +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -0,0 +1,164 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Ll_ast +open Cc_ast +open Res + +let new_anon = map (fun (ast, prog, env, num) -> Result (ast, prog, env, num + 1)) + +let get_anon_name = + map (fun (_, _, _, num) -> Result (String.concat "$" [ "anon"; string_of_int num ])) +;; + +let get_name id stack = String.concat "#" (id :: stack) + +let find_name id = + map (fun (_, _, env, _) -> + match List.find_opt (fun (_, name, _) -> name = id) env with + | None -> + Result (LApp (id, [])) + (* Error (String.concat "" ["Not found new name '"; id; "'\n"]) *) + | Some (_, _, new_name) -> Result (LId new_name)) +;; + +let insert_let a = map (fun (ast, lst, env, num) -> Result (ast, a :: lst, env, num)) + +let update_env name new_name lvl = + map (fun (ast, prog, env, num) -> Result (ast, prog, (lvl, name, new_name) :: env, num)) +;; + +let update_env_fun name stack lvl = update_env name (get_name name stack) lvl +let update_env_arg name lvl = update_env name name lvl +let get_ast = map (fun (ast, _, _, _) -> Result ast) +let get_prog = map (fun (_, prog, _, _) -> Result prog) + +let update_ast f = + map (fun (ast, prog, env, num) -> + f ast >>= fun new_ast -> Result (new_ast, prog, env, num)) +;; + +let filter lvl = + map (fun (ast, prog, env, num) -> + Result (ast, prog, List.filter (fun (l, _, _) -> l < lvl) env, num)) +;; + +let rec lifting cc_ast stack lvl res = + let lifting_bin_op f e1 e2 = + res + |> lifting e1 stack lvl + |> fun r1 -> + r1 + |> get_ast + >>= fun a1 -> r1 |> lifting e2 stack lvl |> update_ast (fun a2 -> Result (f a1 a2)) + in + let get_id = function + | Ast.Decl (id, _) | Ast.DeclRec (id, _) -> id + in + let get_args = function + | Ast.Decl (_, args) | Ast.DeclRec (_, args) -> args + in + let get_fun_let d e = LFun (get_id d, get_args d, e) in + let get_decl = function + | Ast.Decl (id, args) -> Ast.Decl (get_name id stack, args) + | Ast.DeclRec (id, args) -> Ast.DeclRec (get_name id stack, args) + in + let update_env_decl args res = + List.fold_left (fun r a -> r |> update_env_arg a lvl) res args + in + match cc_ast with + | CId id -> res |> find_name id >>= fun ast -> update_ast (fun _ -> Result ast) res + | CConst c -> update_ast (fun _ -> Result (LConst c)) res + | CNot e -> res |> lifting e stack lvl + | COr (e1, e2) -> lifting_bin_op (fun a1 a2 -> LOr (a1, a2)) e1 e2 + | CAnd (e1, e2) -> lifting_bin_op (fun a1 a2 -> LAnd (a1, a2)) e1 e2 + | CEq (e1, e2) -> lifting_bin_op (fun a1 a2 -> LEq (a1, a2)) e1 e2 + | CGt (e1, e2) -> lifting_bin_op (fun a1 a2 -> LGt (a1, a2)) e1 e2 + | CLt (e1, e2) -> lifting_bin_op (fun a1 a2 -> LLt (a1, a2)) e1 e2 + | CGte (e1, e2) -> lifting_bin_op (fun a1 a2 -> LGte (a1, a2)) e1 e2 + | CLte (e1, e2) -> lifting_bin_op (fun a1 a2 -> LLte (a1, a2)) e1 e2 + | CAdd (e1, e2) -> lifting_bin_op (fun a1 a2 -> LAdd (a1, a2)) e1 e2 + | CSub (e1, e2) -> lifting_bin_op (fun a1 a2 -> LSub (a1, a2)) e1 e2 + | CMul (e1, e2) -> lifting_bin_op (fun a1 a2 -> LMul (a1, a2)) e1 e2 + | CDiv (e1, e2) -> lifting_bin_op (fun a1 a2 -> LDiv (a1, a2)) e1 e2 + | CIf (e1, e2, e3) -> + res + |> lifting e1 stack lvl + |> fun r1 -> + r1 + |> get_ast + >>= fun a1 -> + r1 + |> lifting e2 stack lvl + |> fun r2 -> + r2 + |> get_ast + >>= fun a2 -> + r2 |> lifting e3 stack lvl |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) + | CLet (d, e) -> + let id = get_id d in + res + |> update_env_decl (get_args d) + |> update_env_fun id stack lvl + |> lifting e (id :: stack) (lvl + 1) + |> fun r1 -> + r1 |> get_ast >>= fun a -> r1 |> insert_let (get_fun_let (get_decl d) a) |> filter lvl + | CLetIn (d, e1, e2) -> + let id = get_id d in + res + |> update_env_decl (get_args d) + |> update_env_fun id stack lvl + |> lifting e1 (id :: stack) (lvl + 1) + |> (fun r1 -> + r1 |> get_ast >>= fun a -> r1 |> insert_let (get_fun_let (get_decl d) a)) + |> lifting e2 stack lvl + |> filter lvl + | CFun (args, e) -> + res + |> new_anon + |> update_env_decl args + |> fun res -> + res + |> get_anon_name + >>= fun name -> + let new_name = get_name name stack in + res + |> lifting e (name :: stack) (lvl + 1) + |> fun r -> + r + |> get_ast + >>= (fun a -> r |> insert_let (get_fun_let (Ast.Decl (new_name, args)) a)) + |> update_ast (fun _ -> Result (LId new_name)) + | CApp (e, args) -> + List.fold_left + (fun r e -> + r + >>= fun (r, lst) -> + Result r + |> lifting e stack lvl + >>= fun res -> Result res |> get_ast >>= fun a -> Result (res, a :: lst)) + (res >>= fun r -> Result (r, [])) + args + >>= fun (r, args) -> + let args = List.rev args in + Result r + |> lifting e stack lvl + |> update_ast (fun a -> + match a with + | LApp (a, new_args) -> Result (LApp (a, List.append new_args args)) + | LId a -> Result (LApp (a, args)) + | _ -> Error "Apply on not correct expr") +;; + +let default_res = Result (LId "Error", [], [], 0) + +let lambda_lifting cc_ast = + List.fold_left + (fun ll_ast ast -> + ll_ast + >>= fun ll_ast -> + lifting ast [] 0 default_res |> get_prog >>= fun p -> Result (ll_ast @ List.rev p)) + (Result []) + cc_ast +;; diff --git a/slarnML/lib/anf/lambda_lifting.mli b/slarnML/lib/anf/lambda_lifting.mli new file mode 100644 index 000000000..3b0575dce --- /dev/null +++ b/slarnML/lib/anf/lambda_lifting.mli @@ -0,0 +1,5 @@ +open Cc_ast +open Ll_ast +open Res + +val lambda_lifting : c_expr list -> gl_expr list res diff --git a/slarnML/lib/anf/ll_ast.ml b/slarnML/lib/anf/ll_ast.ml new file mode 100644 index 000000000..8f72b9a1c --- /dev/null +++ b/slarnML/lib/anf/ll_ast.ml @@ -0,0 +1,25 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +type l_expr = + | LId of string + | LConst of Ast.const + | LNot of l_expr + | LOr of l_expr * l_expr + | LAnd of l_expr * l_expr + | LEq of l_expr * l_expr + | LGt of l_expr * l_expr + | LLt of l_expr * l_expr + | LGte of l_expr * l_expr + | LLte of l_expr * l_expr + | LAdd of l_expr * l_expr + | LSub of l_expr * l_expr + | LMul of l_expr * l_expr + | LDiv of l_expr * l_expr + | LIf of l_expr * l_expr * l_expr + | LApp of string * l_expr list +[@@deriving show { with_path = false }] + +type gl_expr = LFun of string * string list * l_expr (* declare function *) +type ll_ast = gl_expr list [@@deriving show { with_path = false }] From dd12050efa0ce4a9a017076a7fe169ed0815039c Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:23:06 +0300 Subject: [PATCH 04/24] Add anf conversion --- slarnML/lib/anf/anf_ast.ml | 35 +++++++++++++++ slarnML/lib/anf/anf_conv.ml | 83 ++++++++++++++++++++++++++++++++++++ slarnML/lib/anf/anf_conv.mli | 5 +++ 3 files changed, 123 insertions(+) create mode 100644 slarnML/lib/anf/anf_ast.ml create mode 100644 slarnML/lib/anf/anf_conv.ml create mode 100644 slarnML/lib/anf/anf_conv.mli diff --git a/slarnML/lib/anf/anf_ast.ml b/slarnML/lib/anf/anf_ast.ml new file mode 100644 index 000000000..05e71d3f4 --- /dev/null +++ b/slarnML/lib/anf/anf_ast.ml @@ -0,0 +1,35 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +type immexpr = + | AId of string + | AInt of int + | ABool of bool + | AUnit +[@@deriving show { with_path = false }] + +type cexpr = + | ANot of immexpr + | AOr of immexpr * immexpr + | AAnd of immexpr * immexpr + | AEq of immexpr * immexpr + | AGt of immexpr * immexpr + | ALt of immexpr * immexpr + | AGte of immexpr * immexpr + | ALte of immexpr * immexpr + | AAdd of immexpr * immexpr + | ASub of immexpr * immexpr + | AMul of immexpr * immexpr + | ADiv of immexpr * immexpr + | CImmExpr of immexpr + | AIf of immexpr * aexpr * aexpr + | AApp of immexpr * immexpr list +[@@deriving show { with_path = false }] + +and aexpr = + | ALet of string * cexpr * aexpr + | ACExpr of cexpr +[@@deriving show { with_path = false }] + +type afun = AFun of string * string list * aexpr [@@deriving show { with_path = false }] diff --git a/slarnML/lib/anf/anf_conv.ml b/slarnML/lib/anf/anf_conv.ml new file mode 100644 index 000000000..ee5d1420a --- /dev/null +++ b/slarnML/lib/anf/anf_conv.ml @@ -0,0 +1,83 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Ll_ast +open Anf_ast + +let free = ref 0 + +let next_free _ = + free := !free + 1; + !free +;; + +let clear_free _ = + free := 0; + !free +;; + +let get_name name = + let num = next_free () in + String.concat "" [ name; "#"; string_of_int num ] +;; + +let rec anf_expr e expr_with_hole = + let get_const = function + | Ast.CInt i -> AInt i + | Ast.CBool b -> ABool b + | Ast.CUnit -> AUnit + in + let anf_bin_op f e1 e2 = + anf_expr e1 (fun limm -> + anf_expr e2 (fun rimm -> + let name = get_name "anf_op" in + ALet (name, f limm rimm, expr_with_hole (AId name)))) + in + match e with + | LId id -> expr_with_hole (AId id) + | LConst c -> expr_with_hole (get_const c) + | LNot e -> + anf_expr e (fun imm -> + let name = get_name "anf_not" in + ALet (name, ANot imm, expr_with_hole (AId name))) + | LOr (e1, e2) -> anf_bin_op (fun e1 e2 -> AOr (e1, e2)) e1 e2 + | LAnd (e1, e2) -> anf_bin_op (fun e1 e2 -> AAnd (e1, e2)) e1 e2 + | LEq (e1, e2) -> anf_bin_op (fun e1 e2 -> AEq (e1, e2)) e1 e2 + | LGt (e1, e2) -> anf_bin_op (fun e1 e2 -> AGt (e1, e2)) e1 e2 + | LLt (e1, e2) -> anf_bin_op (fun e1 e2 -> ALt (e1, e2)) e1 e2 + | LGte (e1, e2) -> anf_bin_op (fun e1 e2 -> AGte (e1, e2)) e1 e2 + | LLte (e1, e2) -> anf_bin_op (fun e1 e2 -> ALte (e1, e2)) e1 e2 + | LAdd (e1, e2) -> anf_bin_op (fun e1 e2 -> AAdd (e1, e2)) e1 e2 + | LSub (e1, e2) -> anf_bin_op (fun e1 e2 -> ASub (e1, e2)) e1 e2 + | LMul (e1, e2) -> anf_bin_op (fun e1 e2 -> AMul (e1, e2)) e1 e2 + | LDiv (e1, e2) -> anf_bin_op (fun e1 e2 -> ADiv (e1, e2)) e1 e2 + | LIf (e1, e2, e3) -> + anf_expr e1 (fun cimm -> + let name = get_name "anf_if" in + let t_anf = anf_expr e2 (fun imm -> ACExpr (CImmExpr imm)) in + let f_anf = anf_expr e3 (fun imm -> ACExpr (CImmExpr imm)) in + ALet (name, AIf (cimm, t_anf, f_anf), expr_with_hole (AId name))) + | LApp (id, arg :: args) -> + let args = List.rev args in + anf_expr arg (fun imm_arg -> + (List.fold_left + (fun f a lst imm0 -> anf_expr a (fun imm1 -> f (imm0 :: lst) imm1)) + (fun lst imm -> + let name = get_name "anf_app" in + ALet (name, AApp (AId id, List.rev (imm :: lst)), expr_with_hole (AId name))) + args) + [] + imm_arg) + | LApp (id, []) -> + let name = get_name "anf_app" in + ALet (name, AApp (AId id, []), expr_with_hole (AId name)) +;; + +(* | LApp (id, []) -> expr_with_hole (AId id) *) + +let anf_fun = function + | LFun (id, args, e) -> AFun (id, args, anf_expr e (fun imm -> ACExpr (CImmExpr imm))) +;; + +let anf = List.map anf_fun diff --git a/slarnML/lib/anf/anf_conv.mli b/slarnML/lib/anf/anf_conv.mli new file mode 100644 index 000000000..8e5bc6a4f --- /dev/null +++ b/slarnML/lib/anf/anf_conv.mli @@ -0,0 +1,5 @@ +open Ll_ast +open Anf_ast + +val anf : gl_expr list -> afun list +val clear_free : 'a -> int From 8d5f8b21f442dcb23182de343e8c988c72596d07 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:24:41 +0300 Subject: [PATCH 05/24] Add pretty print and typedtree --- slarnML/lib/inferencer/typedtree.ml | 31 ++++ slarnML/lib/pretty_print/pprint.ml | 196 +++++++++++++++++++++++ slarnML/lib/pretty_print/pprint_anf.ml | 75 +++++++++ slarnML/lib/pretty_print/pprint_ast.ml | 91 +++++++++++ slarnML/lib/pretty_print/pprint_cc.ml | 44 +++++ slarnML/lib/pretty_print/pprint_ll.ml | 36 +++++ slarnML/lib/pretty_print/pprint_riscv.ml | 91 +++++++++++ 7 files changed, 564 insertions(+) create mode 100644 slarnML/lib/inferencer/typedtree.ml create mode 100644 slarnML/lib/pretty_print/pprint.ml create mode 100644 slarnML/lib/pretty_print/pprint_anf.ml create mode 100644 slarnML/lib/pretty_print/pprint_ast.ml create mode 100644 slarnML/lib/pretty_print/pprint_cc.ml create mode 100644 slarnML/lib/pretty_print/pprint_ll.ml create mode 100644 slarnML/lib/pretty_print/pprint_riscv.ml diff --git a/slarnML/lib/inferencer/typedtree.ml b/slarnML/lib/inferencer/typedtree.ml new file mode 100644 index 000000000..9e25a0b9d --- /dev/null +++ b/slarnML/lib/inferencer/typedtree.ml @@ -0,0 +1,31 @@ +(** Copyright 2023-2024, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +type binder = int [@@deriving show { with_path = false }] + +module VarSet = struct + include Stdlib.Set.Make (Int) +end + +type constTy = + | UnitTy + | IntTy + | BoolTy + +type ty = + | PrimTy of constTy + | VarTy of binder + | ArrowTy of ty list +[@@deriving show { with_path = false }] + +type undefinedType = + | Type of ty + | Key of binder + | Undefined + +open Res + +let boolType = Result (Type (PrimTy BoolTy)) +let uniyType = Result (Type (PrimTy UnitTy)) +let intType = Result (Type (PrimTy IntTy)) diff --git a/slarnML/lib/pretty_print/pprint.ml b/slarnML/lib/pretty_print/pprint.ml new file mode 100644 index 000000000..f90bd1f6b --- /dev/null +++ b/slarnML/lib/pretty_print/pprint.ml @@ -0,0 +1,196 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Res +open String + +(* open Pprint_ast *) +open Pprint_cc +open Pprint_ll +open Pprint_anf +open Pprint_riscv +open Ast +open Clos_conv +open Lambda_lifting +open Anf_conv +open Riscv + +(* let p = String.concat "\n" [ + "let fac n = "; + "let rec fack n f = "; + "if (n <= 1) then (f 1)"; + "else (fack n f)"; + "in"; + "(fack (n-1) (fun x -> x));;"; + "let main = (print_int (fac 3));;" +] + ;; + let _ = String.concat "\n" ["let c=(a 1 b w c (fun x->x));;"] + ;; + let _ = String.concat "\n" ["((fun x -> x) 10)"] + ;; + Pprint_ast.print_expr p;; *) + +let pp_clos_conv ast = + match clos_conv ast with + | Result cc_ast -> print_string @@ concat "\n" (List.map pp_cc_expr cc_ast) + | Error e -> print_string e +;; + +let pp_lambda_lifting ast = + match lambda_lifting ast with + | Result ll_ast -> print_string @@ concat "\n" (List.map pp_gl_expr ll_ast) + | Error e -> print_string e +;; + +let pp_anf ast = print_string @@ concat "\n" (List.map pp_anf_afun (anf ast)) + +(* let pp_cc_ll ast = + match clos_conv ast with + | Result cc_ast -> pp_lambda_lifting cc_ast + | Error e -> print_string e + ;; *) + +let pp_cc_ll_anf ast = + match clos_conv ast >>= fun ast -> lambda_lifting ast with + | Result ll_ast -> pp_anf ll_ast + | Error e -> print_string e +;; + +let ast1 = + Let + ( Decl ("a", [ "b" ]) + , LetIn + ( Decl ("c", [ "d"; "e" ]) + , Add (Id "e", Add (Id "d", Id "b")) + , App (Id "c", [ Const (CInt 2); Id "b" ]) ) ) +;; + +let ast2 = + Let + ( Decl ("fac", [ "n" ]) + , LetIn + ( DeclRec ("fack", [ "n"; "k" ]) + , If + ( Lte (Id "n", Const (CInt 1)) + , App (Id "k", [ Const (CInt 1) ]) + , App + ( Id "fack" + , [ Sub (Id "n", Const (CInt 1)) + ; Fun ([ "m" ], App (Id "k", [ Mul (Id "m", Id "n") ])) + ] ) ) + , App (Id "fack", [ Id "n"; Fun ([ "x" ], Id "x") ]) ) ) +;; + +let ast3 = + Let + ( Decl ("fac", [ "n" ]) + , LetIn + ( DeclRec ("fack", [ "k" ]) + , If + ( Lte (Id "n", Const (CInt 1)) + , App (Id "k", [ Const (CInt 1) ]) + , App + ( Id "fack" + , [ Sub (Id "n", Const (CInt 1)) + ; Fun ([ "m" ], App (Id "k", [ Mul (Id "m", Id "n") ])) + ] ) ) + , App (Id "fack", [ Fun ([ "x" ], Id "x") ]) ) ) +;; + +(* + let anf1 = [ +AFun("anon$1#fack#fac",["k";"n";"m"], + ALet("anf_op#1",AMul(AId"m",AId"n"), + ALet("anf_op#2",AMul(AId"k",AId"anf_op#1"), + ACExpr(CImmExpr(AId"anf_op#2")) + ))); +AFun("fack#fac",["n";"k"], + ALet("anf_op#3",ALte(AId"n",AInt 1), + ALet("anf_if#4",AIf(AId"anf_op#3", + ALet("anf_op#5",ASub(AId"n",AInt 1), + ALet("anf_app#6",AApp(AId"n", [AId"anf_op#5"]), + ACExpr(CImmExpr(AId"anf_app#6")) + )), + ALet("anf_app#7",AApp(AId"anon$1#fack#fac",[AId"k";AId"n"]), + ACExpr(CImmExpr(AId"anf_app#7")) + ) + ), + ACExpr(CImmExpr(AId"anf_if#4")) + ))) +(* AFun("anon$2#fac",["x"],ACExpr(CImmExpr(AId"x"))); +AFun("fac",["n"], + ALet("anf_app#8",AApp(AId"fack#fac",[AId"n";AId"anon$2#fac"]), + ACExpr(CImmExpr(AId "anf_app#8")) + )) *) +];; *) + +(* + let ast = ast2 + ;; + pp_ast ast;; + print_string "\n\n" + ;; + pp_clos_conv ast;; + print_string "\n\n" + ;; + pp_cc_ll ast;; + print_string "\n\n" + ;; + pp_cc_ll_anf ast;; + print_string "\n\n\n=====\n\n\n" + ;; +*) +(* pp_clos_conv Clos_conv.ast1;; + print_string@@pp_cc_expr Clos_conv.cc1;; *) + +let pp_asm asm = + match asm with + | Error e -> print_string e + | Result prog -> + print_string @@ String.concat "\n" (List.map (pp_instruction "\t") prog) +;; + +let pp_cc_ll_anf_asm ast = + match clos_conv ast >>= fun ast -> lambda_lifting ast with + | Result ll_ast -> pp_asm (asm (anf ll_ast)) + | Error e -> print_string e +;; + +(* pp_cc_ll_anf_asm [];; *) + +let ast_fac = + [ Let + ( DeclRec ("fac", [ "n" ]) + , If + ( Gt (Id "n", Const (CInt 1)) + , Const (CInt 1) + , Mul (Id "n", App (Id "fac", [ Sub (Id "n", Const (CInt 1)) ])) ) ) + ] +;; + +let ast_fac_1 = + [ Let + ( Decl ("fac", [ "n" ]) + , LetIn + ( DeclRec ("fack", [ "n"; "k" ]) + , If + ( Lte (Id "n", Const (CInt 1)) + , App (Id "k", [ Const (CInt 1) ]) + , App + ( Id "fack" + , [ Sub (Id "n", Const (CInt 1)) + ; Fun ([ "x" ], Mul (Id "x", App (Id "k", [ Id "n" ]))) + ] ) ) + , App (Id "fack", [ Id "n"; Fun ([ "x" ], Id "x") ]) ) ) + ; Let (Decl ("main", []), App (Id "print_int", [ App (Id "fac", [ Const (CInt 6) ]) ])) + ] +;; + +(* pp_cc_ll_anf [];; *) +(* print_string "\n\n\n";; + pp_cc_ll_anf_asm ast_fac_1 + ;; *) +(* pp_cc_ll_anf ast_fac_1 + ;; *) diff --git a/slarnML/lib/pretty_print/pprint_anf.ml b/slarnML/lib/pretty_print/pprint_anf.ml new file mode 100644 index 000000000..c934a2cf1 --- /dev/null +++ b/slarnML/lib/pretty_print/pprint_anf.ml @@ -0,0 +1,75 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Anf_ast +open String + +let pp_anf_immexpr = function + | AId id -> id + | AInt i -> string_of_int i + | ABool b -> string_of_bool b + | AUnit -> "()" +;; + +let rec pp_anf_aexpr tab ae = + let next_tab = concat "" [ "\t"; tab ] in + let pp_anf_cexpr tab = function + | CImmExpr imm -> pp_anf_immexpr imm + | ANot e -> concat "" [ "not "; pp_anf_immexpr e ] + | AOr (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "||"; pp_anf_immexpr e2; ")" ] + | AAnd (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "&&"; pp_anf_immexpr e2; ")" ] + | AEq (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "="; pp_anf_immexpr e2; ")" ] + | AGt (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; ">"; pp_anf_immexpr e2; ")" ] + | ALt (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "<"; pp_anf_immexpr e2; ")" ] + | AGte (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; ">="; pp_anf_immexpr e2; ")" ] + | ALte (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "<="; pp_anf_immexpr e2; ")" ] + | AAdd (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "+"; pp_anf_immexpr e2; ")" ] + | ASub (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "-"; pp_anf_immexpr e2; ")" ] + | AMul (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "*"; pp_anf_immexpr e2; ")" ] + | ADiv (e1, e2) -> concat "" [ "("; pp_anf_immexpr e1; "/"; pp_anf_immexpr e2; ")" ] + | AIf (e1, e2, e3) -> + let next_tab = concat "" [ "\t"; tab ] in + concat + "" + [ "if (" + ; pp_anf_immexpr e1 + ; ")\n" + ; tab + ; "then (\n" + ; next_tab + ; pp_anf_aexpr next_tab e2 + ; "\n" + ; tab + ; ") else (\n" + ; next_tab + ; pp_anf_aexpr next_tab e3 + ; ")" + ] + | AApp (e, args) -> + concat + "" + [ "("; pp_anf_immexpr e; " "; concat " " (List.map pp_anf_immexpr args); ")" ] + in + match ae with + | ALet (id, e1, e2) -> + concat + "" + [ "(let " + ; id + ; "=" + ; pp_anf_cexpr next_tab e1 + ; "\n" + ; tab + ; "in\n" + ; tab + ; pp_anf_aexpr tab e2 + ; ")" + ] + | ACExpr e -> pp_anf_cexpr tab e +;; + +let pp_anf_afun = function + | AFun (id, args, e) -> + concat "" [ "(fun "; id; "("; concat " " args; ")->\n\t"; pp_anf_aexpr "\t" e; "\n)" ] +;; diff --git a/slarnML/lib/pretty_print/pprint_ast.ml b/slarnML/lib/pretty_print/pprint_ast.ml new file mode 100644 index 000000000..4f14612db --- /dev/null +++ b/slarnML/lib/pretty_print/pprint_ast.ml @@ -0,0 +1,91 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Ast +open Parser +open Printf +open String +open Typedtree + +let pp_const = function + | CInt i -> if i < 0 then concat "" [ "("; string_of_int i; ")" ] else string_of_int i + | CBool b -> string_of_bool b + | CUnit -> "()" +;; + +let expr_of_decl = function + | Decl (id, args) -> concat " " (id :: args) + | DeclRec (id, args) -> concat " " ("rec" :: id :: args) +;; + +let rec pp_expr expr = + match expr with + | Id id -> id + | Const c -> pp_const c + | Not e -> concat "" [ "not "; pp_expr e ] + | Or (e1, e2) -> concat "" [ "("; pp_expr e1; "||"; pp_expr e2; ")" ] + | And (e1, e2) -> concat "" [ "("; pp_expr e1; "&&"; pp_expr e2; ")" ] + | Eq (e1, e2) -> concat "" [ "("; pp_expr e1; "="; pp_expr e2; ")" ] + | Gt (e1, e2) -> concat "" [ "("; pp_expr e1; ">"; pp_expr e2; ")" ] + | Lt (e1, e2) -> concat "" [ "("; pp_expr e1; "<"; pp_expr e2; ")" ] + | Gte (e1, e2) -> concat "" [ "("; pp_expr e1; ">="; pp_expr e2; ")" ] + | Lte (e1, e2) -> concat "" [ "("; pp_expr e1; "<="; pp_expr e2; ")" ] + | Add (e1, e2) -> concat "" [ "("; pp_expr e1; "+"; pp_expr e2; ")" ] + | Sub (e1, e2) -> concat "" [ "("; pp_expr e1; "-"; pp_expr e2; ")" ] + | Mul (e1, e2) -> concat "" [ "("; pp_expr e1; "*"; pp_expr e2; ")" ] + | Div (e1, e2) -> concat "" [ "("; pp_expr e1; "/"; pp_expr e2; ")" ] + | If (e1, e2, e3) -> + concat "" [ "if ("; pp_expr e1; ") then ("; pp_expr e2; ") else ("; pp_expr e3; ")" ] + | Let (d, e2) -> concat "" [ "(let "; expr_of_decl d; "="; pp_expr e2; ")" ] + | LetIn (d, e2, e3) -> + concat "" [ "(let "; expr_of_decl d; "="; pp_expr e2; " in "; pp_expr e3; ")" ] + | Fun (args, e) -> concat "" [ "(fun "; concat " " args; "->"; pp_expr e; ")" ] + | App (e, args) -> + concat "" [ "("; pp_expr e; "->"; concat "->" (List.map pp_expr args); ")" ] +;; + +let pp_exprs exprs = concat "\t\n" @@ List.map pp_expr exprs + +let print_expr str = + match parser str with + | Ok e -> print_string @@ concat "\t\t\n" [ pp_exprs e; ";;\n\n" ] + | Error e -> eprintf "there was an error: %s\n" e +;; + +let pp_ast ast = print_string @@ pp_expr ast + +let pp_const_ty = function + | UnitTy -> "Unit" + | BoolTy -> "Bool" + | IntTy -> "Int" +;; + +let rec pp_type = function + | PrimTy c -> pp_const_ty c + | VarTy n -> string_of_int n + | ArrowTy types -> concat "" [ "("; concat "->" (List.map pp_type types); ")" ] +;; + +(* + " not (not ( not_1 ) + 1 *2 / 1 + 2)" + "let a = \nlet b = 1 in\n\t let c = b in\n\t c " + "let t = let k = if a then (let rec a x = x) else (fun x b -> 2*b+x) in k;;" + "let t = let k = if a then (let rec a x = x) else (fun x b -> 2*b+x) in k;; let q = 0" +*) +(* + string " not (not ( not_1 ) + 1 *2 / 1 + 2)" (fun _ -> printf ";;\n"; ());; +*) +(* string "let a b c = 1;; a b c;; let b = a c" (fun _ -> printf ";;\n"; ());; *) +(* print_expr "a + 2 \n\n<= b * 3"; + print_string "\n\n\n"; + print_expr "let a b c = 1;; a b c;; let b = a c";; + print_string "\n\n\n"; + print_expr "(a b) * 3 + (b 1 (a f 2))" + print_string "\n\n\n"; *) +(* print_expr "(a b 2 1+3 * b d + 2)" *) +(* print_expr "(a b 1)" *) +(* print_expr "(a b 2 1+3 * b d (-2) (r f) true) + 3 = 10 && false || 1" ;; *) +(* print_expr "let a = let b = 1 in let c = 2 in d" *) +(* print_expr "true && (a + (f false (g 3 y)) = 3 || 2)";; *) +(* + (b 1 (a f 2) (1 + a)) *) diff --git a/slarnML/lib/pretty_print/pprint_cc.ml b/slarnML/lib/pretty_print/pprint_cc.ml new file mode 100644 index 000000000..00c245830 --- /dev/null +++ b/slarnML/lib/pretty_print/pprint_cc.ml @@ -0,0 +1,44 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Cc_ast +open String + +let rec pp_cc_expr expr = + match expr with + | CId id -> id + | CConst c -> Pprint_ast.pp_const c + | CNot e -> concat "" [ "not "; pp_cc_expr e ] + | COr (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "||"; pp_cc_expr e2; ")" ] + | CAnd (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "&&"; pp_cc_expr e2; ")" ] + | CEq (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "="; pp_cc_expr e2; ")" ] + | CGt (e1, e2) -> concat "" [ "("; pp_cc_expr e1; ">"; pp_cc_expr e2; ")" ] + | CLt (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "<"; pp_cc_expr e2; ")" ] + | CGte (e1, e2) -> concat "" [ "("; pp_cc_expr e1; ">="; pp_cc_expr e2; ")" ] + | CLte (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "<="; pp_cc_expr e2; ")" ] + | CAdd (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "+"; pp_cc_expr e2; ")" ] + | CSub (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "-"; pp_cc_expr e2; ")" ] + | CMul (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "*"; pp_cc_expr e2; ")" ] + | CDiv (e1, e2) -> concat "" [ "("; pp_cc_expr e1; "/"; pp_cc_expr e2; ")" ] + | CIf (e1, e2, e3) -> + concat + "" + [ "if ("; pp_cc_expr e1; ") then ("; pp_cc_expr e2; ") else ("; pp_cc_expr e3; ")" ] + | CLet (d, e2) -> + concat "" [ "(let "; Pprint_ast.expr_of_decl d; "="; pp_cc_expr e2; ")" ] + | CLetIn (d, e2, e3) -> + concat + "" + [ "(let " + ; Pprint_ast.expr_of_decl d + ; "=" + ; pp_cc_expr e2 + ; " in " + ; pp_cc_expr e3 + ; ")" + ] + | CFun (args, e) -> concat "" [ "(fun "; concat " " args; "->"; pp_cc_expr e; ")" ] + | CApp (e, args) -> + concat "" [ "("; pp_cc_expr e; " "; concat " " (List.map pp_cc_expr args); ")" ] +;; diff --git a/slarnML/lib/pretty_print/pprint_ll.ml b/slarnML/lib/pretty_print/pprint_ll.ml new file mode 100644 index 000000000..8934dfef3 --- /dev/null +++ b/slarnML/lib/pretty_print/pprint_ll.ml @@ -0,0 +1,36 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Ll_ast +open String +open Pprint_ast + +let rec pp_ll_expr expr = + match expr with + | LId id -> id + | LConst c -> pp_const c + | LNot e -> concat "" [ "not "; pp_ll_expr e ] + | LOr (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "||"; pp_ll_expr e2; ")" ] + | LAnd (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "&&"; pp_ll_expr e2; ")" ] + | LEq (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "="; pp_ll_expr e2; ")" ] + | LGt (e1, e2) -> concat "" [ "("; pp_ll_expr e1; ">"; pp_ll_expr e2; ")" ] + | LLt (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "<"; pp_ll_expr e2; ")" ] + | LGte (e1, e2) -> concat "" [ "("; pp_ll_expr e1; ">="; pp_ll_expr e2; ")" ] + | LLte (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "<="; pp_ll_expr e2; ")" ] + | LAdd (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "+"; pp_ll_expr e2; ")" ] + | LSub (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "-"; pp_ll_expr e2; ")" ] + | LMul (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "*"; pp_ll_expr e2; ")" ] + | LDiv (e1, e2) -> concat "" [ "("; pp_ll_expr e1; "/"; pp_ll_expr e2; ")" ] + | LIf (e1, e2, e3) -> + concat + "" + [ "if ("; pp_ll_expr e1; ") then ("; pp_ll_expr e2; ") else ("; pp_ll_expr e3; ")" ] + | LApp (e, args) -> + concat "" [ "("; e; " "; concat " " (List.map pp_ll_expr args); ")" ] +;; + +let pp_gl_expr = function + | LFun (id, args, e) -> + concat "" [ "(fun "; id; "("; concat " " args; ")->("; pp_ll_expr e; "))" ] +;; diff --git a/slarnML/lib/pretty_print/pprint_riscv.ml b/slarnML/lib/pretty_print/pprint_riscv.ml new file mode 100644 index 000000000..4293049d7 --- /dev/null +++ b/slarnML/lib/pretty_print/pprint_riscv.ml @@ -0,0 +1,91 @@ +open Riscv_ast +open String + +let pp_reg = function + | Zero -> "zero" + | Ra -> "ra" + | Sp -> "sp" + | S n -> "s" ^ string_of_int n + | A n -> "a" ^ string_of_int n + | T n -> "t" ^ string_of_int n +;; + +let pp_cond = function + | Beq -> "beq " + | Bge -> "bge " + | Bgt -> "bgt " + | Blt -> "blt " + | Ble -> "ble " + | Bne -> "bne " +;; + +let pp_addr = function + | Id id -> id + | Reg r -> pp_reg r +;; + +let pp_math rd r1 r2 op = + let pp_rr rd r1 r2 = concat "," [ pp_reg rd; pp_reg r1; pp_reg r2 ] in + match op with + | I op -> + (match op with + | Add -> "add " ^ pp_rr rd r1 r2 + | And -> "and " ^ pp_rr rd r1 r2 + | Or -> "or " ^ pp_rr rd r1 r2 + | Xor -> "xor " ^ pp_rr rd r1 r2 + | Sll -> "sll " ^ pp_rr rd r1 r2 + | Srl -> "srl " ^ pp_rr rd r1 r2) + | Mul -> "mul " ^ pp_rr rd r1 r2 + | Sub -> "sub " ^ pp_rr rd r1 r2 + | Div -> "div " ^ pp_rr rd r1 r2 +;; + +let pp_imm = function + | ImmInt i -> string_of_int i + | ConstAddr (c, f) -> concat "" [ "%"; c; ""; "("; f; ")" ] +;; + +let pp_mathi rd r1 n op = + let pp_rn rd r1 n = concat "," [ pp_reg rd; pp_reg r1; pp_imm n ] in + match op with + | Add -> "addi " ^ pp_rn rd r1 n + | And -> "andi " ^ pp_rn rd r1 n + | Or -> "ori " ^ pp_rn rd r1 n + | Xor -> "xori " ^ pp_rn rd r1 n + | Sll -> "slli " ^ pp_rn rd r1 n + | Srl -> "srli " ^ pp_rn rd r1 n +;; + +let pp_instruction tab instr = + let pp_stack_arg rd n r1 = + concat "" [ pp_reg rd; ","; pp_imm n; "("; pp_reg r1; ")" ] + in + match instr with + | Tag t -> t ^ ":" + | Math (op, rd, r1, r2) -> tab ^ pp_math rd r1 r2 op + | Mathi (op, rd, r1, r2) -> tab ^ pp_mathi rd r1 r2 op + | Beqz (r1, a) -> "beqz " ^ concat "," [ pp_reg r1; pp_addr a ] + | Bnez (r1, a) -> "bnez " ^ concat "," [ pp_reg r1; pp_addr a ] + | Bnch (cond, r1, r2, a) -> + pp_cond cond ^ concat "," [ pp_reg r1; pp_reg r2; pp_addr a ] + | Call a -> "call " ^ pp_addr a + | Jmp a -> tab ^ "j " ^ pp_addr a + | La (rd, a) -> tab ^ "la " ^ concat "," [ pp_reg rd; pp_addr a ] + | Li (rd, n) -> tab ^ "li " ^ concat "," [ pp_reg rd; pp_imm n ] + | Mv (rd, rs) -> tab ^ "mv " ^ concat "," [ pp_reg rd; pp_reg rs ] + | Ret -> "ret" + | Ld (rd, n, r1) -> tab ^ "ld " ^ pp_stack_arg rd n r1 + | Sd (rd, n, r1) -> tab ^ "sd " ^ pp_stack_arg rd n r1 + | Lui (rd, imm) -> tab ^ "lui " ^ concat "," [ pp_reg rd; pp_imm imm ] + | Ecall -> "ecall" + | Global g -> ".global " ^ g + | Attribute a -> ".attribute " ^ a +;; +(* Unused + | Lb (rd, n, r1) -> "la "^(pp_stack_arg rd n r1) + | Lh (rd, n, r1) -> "lh "^(pp_stack_arg rd n r1) + | Lw (rd, n, r1) -> "lw "^(pp_stack_arg rd n r1) + | Sb (rd, n, r1) -> "sa "^(pp_stack_arg rd n r1) + | Sh (rd, n, r1) -> "sh "^(pp_stack_arg rd n r1) + | Sw (rd, n, r1) -> "sw "^(pp_stack_arg rd n r1) +*) From 5a40eda203172cddd123832d30a52090d5aaaca9 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:25:58 +0300 Subject: [PATCH 06/24] Add riscv64 runtime --- slarnML/lib/riscv64/.gdbinit | 14 + slarnML/lib/riscv64/call_define.ml | 2 + slarnML/lib/riscv64/part_app.c | 122 ++++++ slarnML/lib/riscv64/print.S | 86 ++++ slarnML/lib/riscv64/riscv.ml | 653 +++++++++++++++++++++++++++++ slarnML/lib/riscv64/riscv_ast.ml | 71 ++++ 6 files changed, 948 insertions(+) create mode 100644 slarnML/lib/riscv64/.gdbinit create mode 100644 slarnML/lib/riscv64/call_define.ml create mode 100644 slarnML/lib/riscv64/part_app.c create mode 100644 slarnML/lib/riscv64/print.S create mode 100644 slarnML/lib/riscv64/riscv.ml create mode 100644 slarnML/lib/riscv64/riscv_ast.ml diff --git a/slarnML/lib/riscv64/.gdbinit b/slarnML/lib/riscv64/.gdbinit new file mode 100644 index 000000000..98b540775 --- /dev/null +++ b/slarnML/lib/riscv64/.gdbinit @@ -0,0 +1,14 @@ +set history save +set architecture riscv:rv64 +set sysroot /usr/riscv64−linux−gnu +target remote :1234 +tui enable +# tui new−layout example {−horizontal regs 1 asm 1} 2 status +# cmd 1 +tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 +layout example +# tui disable +focus cmd +b _start +c +# x/8xg $sp \ No newline at end of file diff --git a/slarnML/lib/riscv64/call_define.ml b/slarnML/lib/riscv64/call_define.ml new file mode 100644 index 000000000..b9e5cb59a --- /dev/null +++ b/slarnML/lib/riscv64/call_define.ml @@ -0,0 +1,2 @@ +let exit = 93 +let default_func = [ "print_int", 1; "print_char", 1 ] diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c new file mode 100644 index 000000000..1be02822f --- /dev/null +++ b/slarnML/lib/riscv64/part_app.c @@ -0,0 +1,122 @@ +#define _GNU_SOURCE +#include +#include +#include +#include +#include +#include + +// const uint16_t MAX_APPS = 100; +// const uint8_t MAX_ARGS = 4; +#define MAX_APPS 100 +#define MAX_ARGS 4 + + +int64_t min(int64_t a, int64_t b) { + if (a < b) return a; + else return b; +} + +struct Func +{ + uint8_t argscnt; + uint8_t cnt; + void *ptr; + int64_t *argsfun; +}; +struct Func func_init(void *ptr, uint8_t cnt) { + struct Func new; + new.ptr = ptr; + new.argscnt = cnt; + new.argsfun = malloc(sizeof(int64_t)*min((int64_t)MAX_ARGS, cnt)); + new.cnt = 0; + return new; +} +struct Func *part_apps; +uint16_t last_app = 0; + +int64_t app_n(struct Func *f) { + switch ((*f).argscnt) { + case 0: + int64_t(*f_ptr0)(); + f_ptr0 = (*f).ptr; + return f_ptr0(); + case 1: + int64_t(*f_ptr1)(int64_t); + f_ptr1 = (*f).ptr; + return f_ptr1(f->argsfun[0]); + case 2: + int64_t(*f_ptr2)(int64_t, int64_t); + f_ptr2 = (*f).ptr; + return f_ptr2(f->argsfun[0], f->argsfun[1]); + case 3: + int64_t(*f_ptr3)(int64_t, int64_t, int64_t); + f_ptr3 = (*f).ptr; + return f_ptr3(f->argsfun[0], f->argsfun[1], f->argsfun[2]); + case 4: + int64_t(*f_ptr4)(int64_t, int64_t, int64_t, int64_t); + f_ptr4 = (*f).ptr; + return f_ptr4(f->argsfun[0], f->argsfun[1], f->argsfun[2], f->argsfun[3]); + default: + return -1; + } +} + +int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { + uint8_t f_cnt = f->cnt; + for (; f->cnt < min(MAX_ARGS, min(f_cnt + cnt, f->argscnt)); f->cnt++) { + f->argsfun[f->cnt] = args[f->cnt - f_cnt]; + } + int64_t ret; + if (f->cnt < f->argscnt) { + return (int64_t)f; + } else { + ret = app_n(f); + } + if (f_cnt + cnt > f->argscnt) { + int64_t new_args[MAX_ARGS]; + for (int i = f->argscnt - f_cnt; i < min(MAX_ARGS, cnt); i++) { + new_args[i - (f->argscnt - f_cnt)] = args[i]; + } + return app((void*)ret, f_cnt + cnt - f->argscnt, new_args); + } + else return ret; +} + +int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { + int cnt = 0; + int64_t args[MAX_ARGS]; + va_list argptr; + va_start(argptr, appcnt); + for (int i = 0; i < min(appcnt, MAX_ARGS); i++) { + args[i] = va_arg(argptr, int64_t); + } + va_end(argptr); + if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS]) { + part_apps[last_app] = *(struct Func *)f_ptr; + } else { + part_apps[last_app] = func_init(f_ptr, argcnt); + } + last_app = (last_app + 1) % MAX_APPS; + return app(&part_apps[last_app-1], appcnt, args); +} + +void init_part_apps() { + part_apps = malloc(sizeof(struct Func) * MAX_APPS); +} + +int many_arg(int n,int n1,int n2,int n3,int n4,int n5,int n6,int n7,int n8,int n9,int n10,int n11,int n12,int n13) { + int ret = n+n1+n3+(n4/n2)+n5+n6+n7+n8+n9+n10+n11*n12*n13; + return ret % 256; +} + +int fun ( int a, int b) +{ + return(10*a+b); +} + +int notmain () +{ + return many_arg(0,1,2,3,4,5,6,7,8,9,10,11,12,13); +} + diff --git a/slarnML/lib/riscv64/print.S b/slarnML/lib/riscv64/print.S new file mode 100644 index 000000000..f06f04e82 --- /dev/null +++ b/slarnML/lib/riscv64/print.S @@ -0,0 +1,86 @@ +.global print_char +.global print_int + +print_char: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + + sd a0,-24(s0) + addi a1,s0,-24 + li a0, 1 + li a7, 64 + li a2, 1 + ecall + + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + +print_uint: + addi sp,sp,-64 + sd ra,56(sp) + sd s0,48(sp) + addi s0,sp,64 + + li t0,10 # const + li t1, 8 + li a2, 0 # buffer_size + addi s1,s0,-24 + + .loop1: + li a4,0 + li t2,0 + .loop2: + rem a5,a0,t0 + addi a5,a5,48 + slli a4,a4, 8 + add a4,a4,a5 + addi t2,t2, 1 + div a0,a0,t0 + + beq t1,t2, .end_loop2 + beqz a0, .end_loop2 + j .loop2 + .end_loop2: + sd a4,0(s1) + addi a2,a2, 8 + addi s1,s1,-8 + beqz a0, .end_loop1 + j .loop1 + .end_loop1: + + li a0, 1 + addi a1,s1,8 # & + li a7, 64 # write + ecall + + + ld ra,56(sp) + ld s0,48(sp) + addi sp,sp,64 + ret + +print_int: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + + bge a0,zero, .posit + li a3,-1 + mul a0,a0,a3 + sd a0,-24(s0) + li a0,45 # '-' + call print_char + + ld a0,-24(s0) + .posit: + call print_uint + + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml new file mode 100644 index 000000000..eb1270d81 --- /dev/null +++ b/slarnML/lib/riscv64/riscv.ml @@ -0,0 +1,653 @@ +open Riscv_ast +open Anf_ast + +(* open Pprint_riscv *) +open List +open Res +open Call_define + +let split_at_n n lst = + let rec helper m l r = + if m = 0 + then rev l, r + else ( + match r with + | [] -> rev l, r + | head :: tail -> helper (m - 1) (head :: l) tail) + in + helper n [] lst +;; + +let int_of_bool b = if b then 1 else 0 +let get_offset = map (fun (offset, _, _, _, _, _) -> Result offset) +let get_regs = map (fun (_, regs, _, _, _, _) -> Result regs) +let get_offsets = map (fun (_, _, offsets, _, _, _) -> Result offsets) +let get_free = map (fun (_, _, _, free, _, _) -> Result free) +let get_cond = map (fun (_, _, _, _, cond, _) -> Result cond) + +let update_env f f1 f2 f3 = + map (fun (offset, regs, offsets, free, conds, funs) -> + Result (f offset, f1 regs, f2 offset offsets, f3 free, conds, funs)) +;; + +let update_cond f = + map (fun (offset, regs, offsets, free, conds, funs) -> + Result (offset, regs, offsets, free, f conds, funs)) +;; + +let f_id x = x + +let get_fun name = + map (fun (_, _, _, _, _, funs) -> + Result (List.find_opt (fun (f_name, _) -> f_name = name) funs)) +;; + +let update_funs f = + map (fun (offset, regs, offsets, free, conds, funs) -> + Result (offset, regs, offsets, free, conds, f funs)) +;; + +let add_fun name args_cnt = + map (fun (offset, regs, offsets, free, conds, funs) -> + Result (offset, regs, offsets, free, conds, (name, args_cnt) :: funs)) +;; + +let rec count_max_call_offset offset a = + let count_offset_cexpr = function + | ANot _ + | AOr _ + | AAnd _ + | AEq _ + | AGt _ + | AGte _ + | ALt _ + | ALte _ + | AAdd _ + | ASub _ + | AMul _ + | ADiv _ + | CImmExpr _ -> 0 + | AIf (_, e1, e2) -> + max offset (max (count_max_call_offset offset e1) (count_max_call_offset offset e2)) + | AApp (_, args) -> max 0 (length args - 8) * 8 + in + match a with + | ACExpr e -> count_offset_cexpr e + | ALet (_, c, a) -> + max offset (max (count_offset_cexpr c) (count_max_call_offset offset a)) +;; + +let rec count_offset_aexpr a = + let count_offset_cexpr = function + | ANot _ + | AOr _ + | AAnd _ + | AEq _ + | AGt _ + | AGte _ + | ALt _ + | ALte _ + | AAdd _ + | ASub _ + | AMul _ + | ADiv _ + | CImmExpr _ -> 0 + | AApp (_, args) -> max 3 (length args - 5) * 8 + | AIf (_, e1, e2) -> count_offset_aexpr e1 + count_offset_aexpr e2 + in + match a with + | ACExpr e -> count_offset_cexpr e + | ALet (_, c, a) -> count_offset_cexpr c + count_offset_aexpr a + 8 +;; + +let save_id f id reg res = + map + (fun env -> + res + |> get_offsets + >>= fun offsets -> + match List.find_opt (fun (i, _) -> i = id) offsets with + | Some _ -> Result ([], env) + | None -> + res + |> get_offset + >>= fun offset -> + res + |> update_env f f_id (fun off os -> (id, off) :: os) f_id + >>= fun n_env -> Result ([ Sd (reg, ImmInt offset, S 0) ], n_env)) + res +;; + +let free_some_reg f res = + map + (fun env -> + get_free res + >>= fun free -> + match free with + | [] -> + get_regs res + >>= fun regs -> + (match regs with + | [] -> Error "Regs not exists" + | (rid_opt, reg) :: n_regs -> + res + |> get_offset + >>= fun env_offset -> + res + |> get_offsets + >>= fun offsets -> + let instr, f_offset, f_offsets = + match List.find_opt (fun (i, _) -> Some i = rid_opt) offsets, rid_opt with + | None, Some rid -> + [ Sd (reg, ImmInt (-env_offset), S 0) ], f, fun off os -> (rid, off) :: os + | Some _, _ | None, None -> [], f_id, fun _ x -> x + in + res + |> update_env f_offset (fun _ -> n_regs) f_offsets (fun fr -> reg :: fr) + >>= fun n_env -> Result (instr, n_env)) + | _ -> Result ([], env)) + res +;; + +let free_reg f reg = + map (fun env -> + Result env + |> get_regs + >>= fun regs -> + match List.find_opt (fun (_, r) -> r = reg) regs with + | None -> Result ([], env) + | Some (Some id, reg) -> + Result env + |> save_id f id reg + >>= fun (instr, env) -> + Result env + |> update_env + f_id + (List.filter (fun (_, r) -> r <> reg)) + (fun _ x -> x) + (fun fr -> reg :: fr) + >>= fun env -> Result (instr, env) + | Some (None, reg) -> + update_env + f_id + (List.filter (fun (_, r) -> r <> reg)) + (fun _ x -> x) + (fun fr -> reg :: fr) + (Result env) + >>= fun env -> Result ([], env)) +;; + +let block_reg f opt reg res = + res + |> get_regs + >>= fun regs -> + match List.find_opt (fun (i, r) -> i = opt && r = reg) regs with + | Some _ -> res >>= fun env -> Result ([], env) + | None -> + res + |> free_reg f reg + >>= fun (instr, env) -> + Result env + |> update_env + f_id + (fun rs -> rs @ [ opt, reg ]) + (fun _ x -> x) + (List.filter (fun f -> f <> reg)) + >>= fun env -> Result (instr, env) +;; + +let get_free_reg f res = + res + |> free_some_reg f + >>= fun (instr1, env) -> + Result env + |> get_free + >>= fun free -> + match free with + | [] -> Error "Free is empty" + | reg :: _ -> + res |> free_reg f reg >>= fun (b_instr, env) -> Result (instr1 @ b_instr, reg, env) +;; + +let find_id f id reg_opt res = + map + (fun env -> + get_regs res + >>= fun regs -> + let q_opt = find_opt (fun (i, _) -> i = Some id) regs in + match q_opt with + | Some (_, q) -> + (match reg_opt with + | None -> + Result env + |> block_reg f (Some id) q + >>= fun (instr, env) -> Result (instr, q, env) + | Some r -> + res + |> block_reg f (Some id) r + >>= fun (instr, env) -> Result (instr @ [ Mv (r, q) ], r, env)) + | None -> + get_offsets res + >>= fun offsets -> + (match List.find_opt (fun (i, _) -> i = id) offsets with + | None -> Error (id ^ " not found") + | Some (_, offset) -> + (match reg_opt with + | None -> free_some_reg f res + | Some r -> free_reg f r res) + >>= fun (p_instr, env) -> + (match reg_opt with + | Some r -> + Result env + |> block_reg f (Some id) r + >>= fun (instr, env) -> + Result (p_instr @ instr @ [ Ld (r, ImmInt offset, S 0) ], r, env) + | None -> + Result env + |> get_free_reg f + >>= fun (instr0, r, env) -> + Result env + |> block_reg f (Some id) r + >>= fun (instr, env) -> + Result (p_instr @ instr0 @ instr @ [ Ld (r, ImmInt offset, S 0) ], r, env)))) + res +;; + +let free_regs f res = + res + |> get_regs + >>= fun regs -> + res + >>= fun env -> + List.fold_left + (fun res (_, r) -> + res + >>= fun (instr, env) -> + Result env |> free_reg f r >>= fun (n_instr, env) -> Result (instr @ n_instr, env)) + (Result ([], env)) + regs +;; + +let init_args args res = + let f x = x - 8 in + let s_left_arg cnt a res = + match a with + | AId a -> + res |> find_id f a (Some (A cnt)) >>= fun (instr, _, env) -> Result (instr, env) + | AInt i -> + res + |> block_reg f None (A cnt) + >>= fun (instr, env) -> Result (instr @ [ Li (A cnt, ImmInt i) ], env) + | ABool b -> + res + |> block_reg f None (A cnt) + >>= fun (instr, env) -> Result (instr @ [ Li (A cnt, ImmInt (int_of_bool b)) ], env) + | AUnit -> res >>= fun env -> Result ([], env) + in + let s_right_arg offset a res = + match a with + | AId a -> + res + |> find_id f a (Some (T 6)) + >>= fun (instr, _, env) -> Result (instr @ [ Sd (T 6, ImmInt offset, Sp) ], env) + | AInt i -> + res + |> free_reg f (T 6) + >>= fun (instr, env) -> + Result (instr @ [ Li (T 6, ImmInt i); Sd (T 6, ImmInt offset, Sp) ], env) + | ABool b -> + res + |> free_reg f (T 6) + >>= fun (instr, env) -> + Result + (instr @ [ Li (T 6, ImmInt (int_of_bool b)); Sd (T 6, ImmInt offset, Sp) ], env) + | AUnit -> res |> free_reg f (T 6) >>= fun (instr, env) -> Result (instr, env) + in + let left, right = split_at_n 7 args in + let r_len = length right in + res + >>= fun c_env -> + res + >>= (fun env -> + fold_right + (fun a r -> + r + >>= fun (offset, lst, e) -> + Result e + |> s_right_arg offset a + >>= fun (instr, e) -> Result (offset - 8, instr @ lst, e)) + right + (Result ((r_len - 1) * 8, [], env))) + >>= fun (_, right, env) -> + fold_left + (fun r a -> + r + >>= fun (cnt, lst, e) -> + Result e |> s_left_arg cnt a >>= fun (instr, e) -> Result (cnt + 1, instr @ lst, e)) + (Result (1, [], env)) + left + >>= fun (_, left, _) -> Result (right @ left, c_env) +;; + +let save_args offset args res = + let f o = o + 8 in + res + |> get_offset + >>= fun env_offset -> + res + |> update_env (fun _ -> offset) f_id (fun _ x -> x) f_id + >>= fun env -> + let left, right = split_at_n 8 args in + let _, r_offsets = + List.fold_left (fun (offset, lst) r -> offset + 8, (r, offset) :: lst) (0, []) right + in + fold_right + (fun l r -> + r + >>= fun (cnt, lst, e) -> + Result e + |> block_reg f (Some l) (A cnt) + >>= fun (p_instr, e) -> + Result e + |> save_id f l (A cnt) + >>= fun (instr, e) -> Result (cnt - 1, lst @ p_instr @ instr, e)) + left + (Result (min (length args - 1) 7, [], env)) + >>= fun (_, instr, env) -> + Result env + |> update_env (fun _ -> env_offset) f_id (fun _ x -> r_offsets @ x) f_id + >>= fun env -> Result (instr, env) +;; + +let load_imm f a res = + let load_const n_instr = + res + |> free_some_reg f + >>= fun (instr, env) -> + Result env + |> get_free_reg f + >>= fun (g_instr, reg, env) -> + Result env + |> block_reg f None reg + >>= fun (b_instr, env) -> Result (instr @ g_instr @ b_instr @ n_instr reg, reg, env) + in + match a with + | AId a -> res |> find_id f a None + | AInt i -> load_const (fun reg -> [ Li (reg, ImmInt i) ]) + | ABool b -> load_const (fun reg -> [ Li (reg, ImmInt (int_of_bool b)) ]) + | AUnit -> load_const (fun _ -> []) +;; + +let filter_tag = String.map (fun c -> if c = '#' || c = '$' then '_' else c) + +let rec build_aexpr tag a res = + let f o = o - 8 in + let get_tag id = ".tag_" ^ filter_tag id in + let get_tag_addr id = Id (get_tag (filter_tag id)) in + let get_true_tag id = ".tag_" ^ filter_tag id ^ "_t" in + let get_true_tag_addr id = Id (get_true_tag (filter_tag id)) in + let build_cexpr tag c res = + let bin_op op i1 i2 = + res + |> load_imm f i1 + >>= fun (instr1, reg1, env) -> + Result env + |> load_imm f i2 + >>= fun (instr2, reg2, env) -> + Result env + |> free_some_reg f + >>= fun (instrf, env) -> + Result env + |> get_free_reg f + >>= fun (instrg, regd, env) -> + Result (instr1 @ instr2 @ instrf @ instrg @ [ op regd reg1 reg2 ], Some regd, env) + in + let cond_op op i1 i2 = + res + |> load_imm f i1 + >>= fun (instr1, reg1, env) -> + Result env + |> load_imm f i2 + >>= fun (instr2, reg2, env) -> + Result env + |> update_cond (fun c -> (tag, op reg1 reg2) :: c) + >>= fun env -> Result (instr1 @ instr2, None, env) + in + match c with + | AOr (i1, i2) -> bin_op (fun rd r1 r2 -> Math (I Or, rd, r1, r2)) i1 i2 + | AAnd (i1, i2) -> bin_op (fun rd r1 r2 -> Math (I And, rd, r1, r2)) i1 i2 + | AAdd (i1, i2) -> bin_op (fun rd r1 r2 -> Math (I Add, rd, r1, r2)) i1 i2 + | ASub (i1, i2) -> bin_op (fun rd r1 r2 -> Math (Sub, rd, r1, r2)) i1 i2 + | AMul (i1, i2) -> bin_op (fun rd r1 r2 -> Math (Mul, rd, r1, r2)) i1 i2 + | ADiv (i1, i2) -> bin_op (fun rd r1 r2 -> Math (Div, rd, r1, r2)) i1 i2 + | AEq (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Beq, r1, r2, tag)) i1 i2 + | AGte (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Bge, r2, r1, tag)) i1 i2 + | ALte (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Ble, r2, r1, tag)) i1 i2 + | AGt (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Bgt, r2, r1, tag)) i1 i2 + | ALt (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Blt, r2, r1, tag)) i1 i2 + | ANot i -> + res + |> load_imm f i + >>= fun (instr, reg, env) -> + Result (instr @ [ Mathi (Xor, reg, reg, ImmInt (-1)) ], Some reg, env) + | CImmExpr i -> + res |> load_imm f i >>= fun (instr, reg, env) -> Result (instr, Some reg, env) + | AApp (i, args) -> + (match i with + | AId id -> + res + |> get_fun id + >>= fun c_opt -> + let load_ptr c_opt r = + match c_opt with + | None -> + r + |> find_id f id (Some (A 0)) + >>= fun (instr_fun, _, env) -> Result (instr_fun, 0, env) + | Some (_, c) -> + r + |> block_reg f None (A 0) + >>= fun (instr_fun, env) -> + Result + ( instr_fun + @ [ Lui (A 0, ConstAddr ("hi", filter_tag id)) + ; Mathi (Add, A 0, A 0, ConstAddr ("lo", filter_tag id)) + ] + , c + , env ) + in + res + |> free_regs f + >>= fun (instr_free, env) -> + Result env + |> load_ptr c_opt + >>= fun (instr_fun, c, env) -> + Result env + |> init_args ([ AInt c; AInt (List.length args) ] @ args) + >>= fun (instr_args, env) -> + Result + ( instr_free @ instr_fun @ instr_args @ [ Call (Id "part_app") ] + , Some (A 0) + , env ) + | _ -> Error "Call some shit") + | AIf (ec, e1, e2) -> + let free_a0 = free_reg f (A 0) in + let id = "if_bnch" in + let dflt_bnch res = + res + >>= (fun (instr0, reg, env) -> + Result ([], None, env) + |> build_aexpr tag e1 + >>= fun (instr1, reg1, env) -> + (match reg1 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result + ( instr0 + @ (Beqz (reg, get_tag_addr id) :: instr1) + @ instr2 + @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] + , Some (A 0) + , env )) + |> build_aexpr tag e2 + >>= fun (instr1, reg2, env) -> + (match reg2 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result (instr1 @ instr2 @ [ Tag (get_true_tag id) ], Some (A 0), env) + in + (match ec with + | AId id -> + res + |> get_cond + >>= fun conds -> + (match List.find_opt (fun (t, _) -> t = get_tag_addr id) conds with + | Some (_, cond) -> + res + >>= (fun env -> + Result ([], None, env) + |> build_aexpr tag e1 + >>= fun (instr1, reg1, env) -> + (match reg1 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result + ( (cond :: instr1) + @ instr2 + @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] + , Some (A 0) + , env )) + |> build_aexpr tag e2 + >>= fun (instr1, reg2, env) -> + (match reg2 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result (instr1 @ instr2 @ [ Tag (get_true_tag id) ], Some (A 0), env) + | None -> res |> load_imm f ec |> dflt_bnch) + | _ -> res |> load_imm f ec |> dflt_bnch) + in + res + >>= fun (instr0, _, env) -> + match a with + | ACExpr c -> + Result env + |> build_cexpr tag c + >>= fun (instr1, reg, env) -> Result (instr0 @ instr1, reg, env) + | ALet (id, c, a) -> + Result env + |> build_cexpr (get_tag_addr id) c + >>= fun (instr1, reg_opt, env) -> + (match reg_opt with + | None -> Result (instr0 @ instr1, None, env) |> build_aexpr tag a + | Some reg -> + Result env + |> block_reg f (Some id) reg + >>= fun (instr2, env) -> + Result (instr0 @ instr1 @ instr2, Some reg, env) |> build_aexpr tag a) +;; + +let init_fun anf res = + match anf with + | AFun (id, args, e) -> + let offset_call = 0 in + let offset_args = min 8 (length args) * 8 in + let offset_expr = count_offset_aexpr e in + let offset_reserved = 2 * 8 in + let offset_full = offset_call + offset_args + offset_expr + offset_reserved in + let offset_align = (offset_full + 15) / 16 * 16 in + res + |> add_fun id (List.length args) + |> save_args (-offset_full) args + >>= fun (s_argsi, env) -> + Result ([], None, env) + |> build_aexpr (Id "") e + >>= fun (e_instr, reg, _) -> + (match reg with + | None -> Error "Void?" + | Some reg -> + Result + ( (Tag (filter_tag id) + :: [ Mathi (Add, Sp, Sp, ImmInt (-offset_align)) + ; Sd (Ra, ImmInt (offset_full - 8), Sp) + ; Sd (S 0, ImmInt (offset_full - 16), Sp) + ; Mathi (Add, S 0, Sp, ImmInt offset_align) + ]) + @ s_argsi + @ e_instr + @ [ Mv (A 0, reg) + ; Ld (Ra, ImmInt (offset_full - 8), Sp) + ; Ld (S 0, ImmInt (offset_full - 16), Sp) + ; Mathi (Add, Sp, Sp, ImmInt offset_align) + ; Ret + ] + , [ id, List.length args ] )) +;; + +let head = + [ Attribute "unaligned_access, 0" + ; Attribute "stack_align, 16" + ; Global "_start" + ; Tag "_start" + ; Mathi (Add, Sp, Sp, ImmInt (-24)) + ; Sd (Ra, ImmInt 16, Sp) + ; Sd (S 0, ImmInt 8, Sp) + ; Sd (S 1, ImmInt 0, Sp) + ; Mathi (Add, S 0, Sp, ImmInt 24) + ; Call (Id "init_part_apps") + ; Call (Id "main") + ; Ld (Ra, ImmInt 16, Sp) + ; Ld (S 0, ImmInt 8, Sp) + ; Ld (S 1, ImmInt 0, Sp) + ; Mathi (Add, Sp, Sp, ImmInt 24) + ; Li (A 7, ImmInt exit) + ; Ecall + ] +;; + +let default_res = + Result + ( -24 + , [] + , [] + , [ T 0; T 1; T 2; T 3; T 4; T 5; T 6; A 0; A 1; A 2; A 3; A 4; A 5; A 6; A 7 ] + , [] + , default_func ) +;; + +(* let asm anf = + List.fold_left (fun prog r -> prog >>= (fun prog -> r >>= (fun (a, _)->Result(prog@a)))) (Result []) + (List.map (init_fun default_res) anf) + ;; *) +let asm anf_lst = + List.fold_left + (fun r anf -> + r + >>= fun (prog, p_f) -> + default_res + |> update_funs (fun d -> d @ p_f) + |> init_fun anf + >>= fun (instr, f) -> Result (prog @ instr, p_f @ f)) + (Result (head, [])) + anf_lst + >>= fun (prog, _) -> Result prog +;; diff --git a/slarnML/lib/riscv64/riscv_ast.ml b/slarnML/lib/riscv64/riscv_ast.ml new file mode 100644 index 000000000..fd8823da5 --- /dev/null +++ b/slarnML/lib/riscv64/riscv_ast.ml @@ -0,0 +1,71 @@ +type reg = + | Zero (* Вечный и неизменный ноль *) + | Ra (* Адрес возврата *) + | Sp (* Stack pointer, указатель стека *) + | S of int (* Рабочие регистры 0-11 *) + | A of int (* Аргументы функции 0-7 / Возвращаемое значение функции 0,1 *) + | T of int (* Временные регистры 0-6 *) +[@@deriving show { with_path = false }] + +type imm = + | ImmInt of int + | ConstAddr of string * string +[@@deriving show { with_path = false }] + +type addr = + | Id of string + | Reg of reg +[@@deriving show { with_path = false }] + +type cond = + | Beq (* if(r1==r2)goto addr *) + | Bge (* if(r1>=r2)goto addr *) + | Bgt (* if(r1>r2)goto addr *) + | Blt (* if(r1=r2)goto addr *) + | Bne (* if(r1!=r2)goto addr *) +[@@deriving show { with_path = false }] + +type math_i = + | Add (* + *) + | And (* & *) + | Sll (* << *) + | Srl (* >> *) + | Or (* | *) + | Xor (* ^ *) + +type math_op = + | I of math_i + | Mul (* * *) + | Sub (* - *) + | Div (* / *) +[@@deriving show { with_path = false }] + +type instruction = + | Attribute of string + | Global of string + | Tag of string + | Math of math_op * reg * reg * reg (* rd = r1 (op) r2 *) + | Mathi of math_i * reg * reg * imm (* rd = r1 (op) N *) + | Beqz of reg * addr (* if(r1==0)goto addr *) + | Bnez of reg * addr (* if(r1!=0)goto addr *) + | Bnch of cond * reg * reg * addr (* if(r1 ? r2)goto addr *) + | Call of addr (* вызов функции func *) + | Jmp of addr (* goto addr *) + | La of reg * addr (* rd = addr *) + | Li of reg * imm (* rd = N *) + | Mv of reg * reg (* rd = rs *) + | Ret (* возврат из функции *) + | Ld of reg * imm * reg (* считать 8 байта по адресу r1+N *) + | Sd of reg * imm * reg (* записать 8 байта по адресу r1+N *) + | Lui of reg * imm + | Ecall +(* Unused + | Lb of reg * int * reg (* считать 1 байт по адресу r1+N *) + | Lh of reg * int * reg (* cчитать 2 байта по адресу r1+N *) + | Lw of reg * int * reg (* считать 4 байта по адресу r1+N *) + | Sb of reg * int * reg (* записать 1 байт по адресу r1+N *) + | Sh of reg * int * reg (* записать 2 байта по адресу r1+N *) + | Sw of reg * int * reg (* записать 4 байта по адресу r1+N *) +*) +[@@deriving show { with_path = false }] From 89b2f26e863e256b09fac69c31f7bb68c6a41a6c Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:28:40 +0300 Subject: [PATCH 07/24] Add anf unit tests --- slarnML/lib/test/anf_test.ml | 496 +++++++++++++++++++++++++++++++++++ slarnML/test/dune | 2 + slarnML/test/slarnML.ml | 0 3 files changed, 498 insertions(+) create mode 100644 slarnML/lib/test/anf_test.ml create mode 100644 slarnML/test/dune create mode 100644 slarnML/test/slarnML.ml diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml new file mode 100644 index 000000000..776ea10ef --- /dev/null +++ b/slarnML/lib/test/anf_test.ml @@ -0,0 +1,496 @@ +(** Copyright 2024-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +open Res + +(*==============================*) +(*======Closure conversion======*) +(*==============================*) +open Ast +open Cc_ast +open Clos_conv +open Pprint_cc + +let cc_ok n res expected = + match res with + | Result c_ast when c_ast = expected -> true + | Result c_ast -> + print_string + @@ String.concat + "" + [ n + ; ":\n" + ; String.concat "\n" (List.map pp_cc_expr c_ast) + ; "\n" + ; String.concat "\n" (List.map pp_cc_expr expected) + ; "\n====\n" + ]; + false + | Error e -> + Printf.printf "%s: %s\n" n e; + false +;; + +let ast1 = + [ Let + ( Decl ("fac", [ "n" ]) + , LetIn + ( DeclRec ("fack", [ "n"; "k" ]) + , If + ( Lte (Id "n", Const (CInt 1)) + , App (Id "n", [ Sub (Id "n", Const (CInt 1)) ]) + , Fun ([ "m" ], Mul (Id "k", Mul (Id "m", Id "n"))) ) + , App (Id "fack", [ Id "n"; Fun ([ "x" ], Id "x") ]) ) ) + ] +;; + +let cc1 = + [ CLet + ( Decl ("fac", [ "n" ]) + , CLetIn + ( DeclRec ("fack", [ "n"; "k" ]) + , CIf + ( CLte (CId "n", CConst (CInt 1)) + , CApp (CApp (CId "n", []), [ CSub (CId "n", CConst (CInt 1)) ]) + , CApp + ( CFun ([ "k"; "n"; "m" ], CMul (CId "k", CMul (CId "m", CId "n"))) + , [ CId "k"; CId "n" ] ) ) + , CApp (CApp (CId "fack", []), [ CId "n"; CApp (CFun ([ "x" ], CId "x"), []) ]) + ) ) + ] +;; + +let%test _ = cc_ok "cc_1" (clos_conv ast1) cc1 + +let ast2 = + [ Let + ( Decl ("f", [ "a" ]) + , LetIn + ( Decl ("g", [ "c"; "d" ]) + , LetIn + ( Decl ("h", [ "e" ]) + , Mul (Id "a", Add (Id "c", Mul (Id "d", Id "e"))) + , App (Id "h", [ Const (CInt 4) ]) ) + , App (Id "g", [ Const (CInt 2); Const (CInt 3) ]) ) ) + ] +;; + +let cc2 = + [ CLet + ( Decl ("f", [ "a" ]) + , CLetIn + ( Decl ("g", [ "a"; "c"; "d" ]) + , CLetIn + ( Decl ("h", [ "a"; "c"; "d"; "e" ]) + , CMul (CId "a", CAdd (CId "c", CMul (CId "d", CId "e"))) + , CApp (CApp (CId "h", [ CId "a"; CId "c"; CId "d" ]), [ CConst (CInt 4) ]) + ) + , CApp (CApp (CId "g", [ CId "a" ]), [ CConst (CInt 2); CConst (CInt 3) ]) ) ) + ] +;; + +let%test _ = cc_ok "cc_2" (clos_conv ast2) cc2 + +let ast3 = + [ Let + ( Decl ("f", [ "a"; "b" ]) + , LetIn + ( Decl ("g", [ "c" ]) + , LetIn + ( Decl ("h", []) + , Fun ([ "x" ], Mul (Id "x", App (Id "a", [ Mul (Id "c", Id "b") ]))) + , App (Id "h", [ Id "a" ]) ) + , App (Id "g", [ Const (CInt 3) ]) ) ) + ] +;; + +let cc3 = + [ CLet + ( Decl ("f", [ "a"; "b" ]) + , CLetIn + ( Decl ("g", [ "b"; "a"; "c" ]) + , CLetIn + ( Decl ("h", [ "c"; "b"; "a" ]) + , CApp + ( CFun + ( [ "c"; "b"; "a"; "x" ] + , CMul + (CId "x", CApp (CApp (CId "a", []), [ CMul (CId "c", CId "b") ])) + ) + , [ CId "c"; CId "b"; CId "a" ] ) + , CApp (CApp (CId "h", [ CId "c"; CId "b"; CId "a" ]), [ CId "a" ]) ) + , CApp (CApp (CId "g", [ CId "b"; CId "a" ]), [ CConst (CInt 3) ]) ) ) + ] +;; + +let%test _ = cc_ok "cc_3" (clos_conv ast3) cc3 + +let ast4 = + [ Let + ( Decl ("f", [ "a" ]) + , LetIn + ( Decl ("g", [ "a"; "b" ]) + , LetIn + ( Decl ("h", [ "b"; "c" ]) + , Mul (Id "a", Div (Id "b", Id "c")) + , App (Id "h", [ Const (CInt 2); Const (CInt 3) ]) ) + , App (Id "g", [ Add (Const (CInt 1), Const (CInt 0)); Id "a" ]) ) ) + ] +;; + +let cc4 = + [ CLet + ( Decl ("f", [ "a" ]) + , CLetIn + ( Decl ("g", [ "a"; "b" ]) + , CLetIn + ( Decl ("h", [ "a"; "b"; "c" ]) + , CMul (CId "a", CDiv (CId "b", CId "c")) + , CApp (CApp (CId "h", [ CId "a" ]), [ CConst (CInt 2); CConst (CInt 3) ]) + ) + , CApp (CApp (CId "g", []), [ CAdd (CConst (CInt 1), CConst (CInt 0)); CId "a" ]) + ) ) + ] +;; + +let%test _ = cc_ok "cc_4" (clos_conv ast4) cc4 + +let ast5 = + [ Let + ( Decl ("f", [ "a" ]) + , LetIn + ( Decl ("g", [ "b" ]) + , Div (Id "a", Id "b") + , LetIn + ( Decl ("h", [ "c" ]) + , Mul (Id "a", Id "c") + , Add (App (Id "h", [ Const (CInt 1) ]), App (Id "g", [ Const (CInt 2) ])) + ) ) ) + ] +;; + +let cc5 = + [ CLet + ( Decl ("f", [ "a" ]) + , CLetIn + ( Decl ("g", [ "a"; "b" ]) + , CDiv (CId "a", CId "b") + , CLetIn + ( Decl ("h", [ "a"; "c" ]) + , CMul (CId "a", CId "c") + , CAdd + ( CApp (CApp (CId "h", [ CId "a" ]), [ CConst (CInt 1) ]) + , CApp (CApp (CId "g", [ CId "a" ]), [ CConst (CInt 2) ]) ) ) ) ) + ] +;; + +let%test _ = cc_ok "cc_5" (clos_conv ast5) cc5 + +let ast6 = + [ Let + ( Decl ("f", [ "a" ]) + , LetIn + ( Decl ("g", []) + , Fun ([ "x" ], Id "x") + , LetIn + ( Decl ("h", []) + , Fun ([ "x" ], Mul (Id "a", Id "x")) + , Add (App (Id "g", [ Id "a" ]), App (Id "h", [ Id "a" ])) ) ) ) + ] +;; + +let cc6 = + [ CLet + ( Decl ("f", [ "a" ]) + , CLetIn + ( Decl ("g", []) + , CApp (CFun ([ "x" ], CId "x"), []) + , CLetIn + ( Decl ("h", [ "a" ]) + , CApp (CFun ([ "a"; "x" ], CMul (CId "a", CId "x")), [ CId "a" ]) + , CAdd + ( CApp (CApp (CId "g", []), [ CId "a" ]) + , CApp (CApp (CId "h", [ CId "a" ]), [ CId "a" ]) ) ) ) ) + ] +;; + +let%test _ = cc_ok "cc_6" (clos_conv ast6) cc6 + +(*==========================*) +(*======Lambda lifting======*) +(*==========================*) +open Ll_ast +open Lambda_lifting +open Pprint_ll + +let ll_ok n res expected = + match res with + | Result l_ast when l_ast = expected -> true + | Result l_ast -> + print_string + @@ String.concat + "" + [ n + ; ":\n" + ; String.concat "\n" (List.map pp_gl_expr l_ast) + ; "\n---\n" + ; String.concat "\n" (List.map pp_gl_expr expected) + ; "\n====\n" + ]; + false + | Error e -> + Printf.printf "%s: %s\n" n e; + false +;; + +let ll1 = + [ LFun ("anon$1#fack#fac", [ "k"; "n"; "m" ], LMul (LId "k", LMul (LId "m", LId "n"))) + ; LFun + ( "fack#fac" + , [ "n"; "k" ] + , LIf + ( LLte (LId "n", LConst (CInt 1)) + , LApp ("n", [ LSub (LId "n", LConst (CInt 1)) ]) + , LApp ("anon$1#fack#fac", [ LId "k"; LId "n" ]) ) ) + ; LFun ("anon$2#fac", [ "x" ], LId "x") + ; LFun ("fac", [ "n" ], LApp ("fack#fac", [ LId "n"; LApp ("anon$2#fac", []) ])) + ] +;; + +ll_ok "ll_1" (lambda_lifting cc1) ll1 + +let ll2 = + [ LFun + ( "h#g#f" + , [ "a"; "c"; "d"; "e" ] + , LMul (LId "a", LAdd (LId "c", LMul (LId "d", LId "e"))) ) + ; LFun + ( "g#f" + , [ "a"; "c"; "d" ] + , LApp ("h#g#f", [ LId "a"; LId "c"; LId "d"; LConst (CInt 4) ]) ) + ; LFun ("f", [ "a" ], LApp ("g#f", [ LId "a"; LConst (CInt 2); LConst (CInt 3) ])) + ] +;; + +ll_ok "ll_2" (lambda_lifting cc2) ll2 + +let ll3 = + [ LFun + ( "anon$1#h#g#f" + , [ "c"; "b"; "a"; "x" ] + , LMul (LId "x", LApp ("a", [ LMul (LId "c", LId "b") ])) ) + ; LFun ("h#g#f", [ "c"; "b"; "a" ], LApp ("anon$1#h#g#f", [ LId "c"; LId "b"; LId "a" ])) + ; LFun ("g#f", [ "b"; "a"; "c" ], LApp ("h#g#f", [ LId "c"; LId "b"; LId "a"; LId "a" ])) + ; LFun ("f", [ "a"; "b" ], LApp ("g#f", [ LId "b"; LId "a"; LConst (CInt 3) ])) + ] +;; + +ll_ok "ll_3" (lambda_lifting cc3) ll3 + +let ll4 = + [ LFun ("h#g#f", [ "a"; "b"; "c" ], LMul (LId "a", LDiv (LId "b", LId "c"))) + ; LFun + ("g#f", [ "a"; "b" ], LApp ("h#g#f", [ LId "a"; LConst (CInt 2); LConst (CInt 3) ])) + ; LFun ("f", [ "a" ], LApp ("g#f", [ LAdd (LConst (CInt 1), LConst (CInt 0)); LId "a" ])) + ] +;; + +ll_ok "ll_4" (lambda_lifting cc4) ll4 + +let ll5 = + [ LFun ("g#f", [ "a"; "b" ], LDiv (LId "a", LId "b")) + ; LFun ("h#f", [ "a"; "c" ], LMul (LId "a", LId "c")) + ; LFun + ( "f" + , [ "a" ] + , LAdd + ( LApp ("h#f", [ LId "a"; LConst (CInt 1) ]) + , LApp ("g#f", [ LId "a"; LConst (CInt 2) ]) ) ) + ] +;; + +ll_ok "ll_5" (lambda_lifting cc5) ll5 + +let ll6 = + [ LFun ("anon$1#g#f", [ "x" ], LId "x") + ; LFun ("g#f", [], LApp ("anon$1#g#f", [])) + ; LFun ("anon$2#h#f", [ "a"; "x" ], LMul (LId "a", LId "x")) + ; LFun ("h#f", [ "a" ], LApp ("anon$2#h#f", [ LId "a" ])) + ; LFun + ("f", [ "a" ], LAdd (LApp ("g#f", [ LId "a" ]), LApp ("h#f", [ LId "a"; LId "a" ]))) + ] +;; + +ll_ok "ll_6" (lambda_lifting cc6) ll6 + +(*=========================*) +(*===========ANF===========*) +(*=========================*) +open Anf_ast +open Anf_conv +open Pprint_anf + +let anf_ok n ll expected = + let _ = clear_free () in + match anf ll with + | l_ast when l_ast = expected -> true + | l_ast -> + print_string + @@ String.concat + "" + [ n + ; ":\n" + ; String.concat "\n" (List.map pp_anf_afun l_ast) + ; "\n---\n" + ; String.concat "\n" (List.map pp_anf_afun expected) + ; "\n====\n" + ]; + false +;; + +let anf1 = + [ AFun + ( "anon$1#fack#fac" + , [ "k"; "n"; "m" ] + , ALet + ( "anf_op#1" + , AMul (AId "m", AId "n") + , ALet + ( "anf_op#2" + , AMul (AId "k", AId "anf_op#1") + , ACExpr (CImmExpr (AId "anf_op#2")) ) ) ) + ; AFun + ( "fack#fac" + , [ "n"; "k" ] + , ALet + ( "anf_op#3" + , ALte (AId "n", AInt 1) + , ALet + ( "anf_if#4" + , AIf + ( AId "anf_op#3" + , ALet + ( "anf_op#5" + , ASub (AId "n", AInt 1) + , ALet + ( "anf_app#6" + , AApp (AId "n", [ AId "anf_op#5" ]) + , ACExpr (CImmExpr (AId "anf_app#6")) ) ) + , ALet + ( "anf_app#7" + , AApp (AId "anon$1#fack#fac", [ AId "k"; AId "n" ]) + , ACExpr (CImmExpr (AId "anf_app#7")) ) ) + , ACExpr (CImmExpr (AId "anf_if#4")) ) ) ) + ; AFun ("anon$2#fac", [ "x" ], ACExpr (CImmExpr (AId "x"))) + ; AFun + ( "fac" + , [ "n" ] + , ALet + ( "anf_app#8" + , AApp (AId "anon$2#fac", []) + , ALet + ( "anf_app#9" + , AApp (AId "fack#fac", [ AId "n"; AId "anf_app#8" ]) + , ACExpr (CImmExpr (AId "anf_app#9")) ) ) ) + ] +;; + +let%test _ = anf_ok "anf_1" ll1 anf1 + +let anf4 = + [ AFun + ( "h#g#f" + , [ "a"; "b"; "c" ] + , ALet + ( "anf_op#1" + , ADiv (AId "b", AId "c") + , ALet + ( "anf_op#2" + , AMul (AId "a", AId "anf_op#1") + , ACExpr (CImmExpr (AId "anf_op#2")) ) ) ) + ; AFun + ( "g#f" + , [ "a"; "b" ] + , ALet + ( "anf_app#3" + , AApp (AId "h#g#f", [ AId "a"; AInt 2; AInt 3 ]) + , ACExpr (CImmExpr (AId "anf_app#3")) ) ) + ; AFun + ( "f" + , [ "a" ] + , ALet + ( "anf_op#4" + , AAdd (AInt 1, AInt 0) + , ALet + ( "anf_app#5" + , AApp (AId "g#f", [ AId "anf_op#4"; AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app#5")) ) ) ) + ] +;; + +let%test _ = anf_ok "anf_4" ll4 anf4 + +let anf5 = + [ AFun + ( "g#f" + , [ "a"; "b" ] + , ALet ("anf_op#1", ADiv (AId "a", AId "b"), ACExpr (CImmExpr (AId "anf_op#1"))) ) + ; AFun + ( "h#f" + , [ "a"; "c" ] + , ALet ("anf_op#2", AMul (AId "a", AId "c"), ACExpr (CImmExpr (AId "anf_op#2"))) ) + ; AFun + ( "f" + , [ "a" ] + , ALet + ( "anf_app#3" + , AApp (AId "h#f", [ AId "a"; AInt 1 ]) + , ALet + ( "anf_app#4" + , AApp (AId "g#f", [ AId "a"; AInt 2 ]) + , ALet + ( "anf_op#5" + , AAdd (AId "anf_app#3", AId "anf_app#4") + , ACExpr (CImmExpr (AId "anf_op#5")) ) ) ) ) + ] +;; + +let%test _ = anf_ok "anf_5" ll5 anf5 + +let anf6 = + [ AFun ("anon$1#g#f", [ "x" ], ACExpr (CImmExpr (AId "x"))) + ; AFun + ( "g#f" + , [] + , ALet + ("anf_app#1", AApp (AId "anon$1#g#f", []), ACExpr (CImmExpr (AId "anf_app#1"))) + ) + ; AFun + ( "anon$2#h#f" + , [ "a"; "x" ] + , ALet ("anf_op#2", AMul (AId "a", AId "x"), ACExpr (CImmExpr (AId "anf_op#2"))) ) + ; AFun + ( "h#f" + , [ "a" ] + , ALet + ( "anf_app#3" + , AApp (AId "anon$2#h#f", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app#3")) ) ) + ; AFun + ( "f" + , [ "a" ] + , ALet + ( "anf_app#4" + , AApp (AId "g#f", [ AId "a" ]) + , ALet + ( "anf_app#5" + , AApp (AId "h#f", [ AId "a"; AId "a" ]) + , ALet + ( "anf_op#6" + , AAdd (AId "anf_app#4", AId "anf_app#5") + , ACExpr (CImmExpr (AId "anf_op#6")) ) ) ) ) + ] +;; + +let%test _ = anf_ok "anf_6" ll6 anf6 diff --git a/slarnML/test/dune b/slarnML/test/dune new file mode 100644 index 000000000..e3ef267bd --- /dev/null +++ b/slarnML/test/dune @@ -0,0 +1,2 @@ +(test + (name slarnML)) diff --git a/slarnML/test/slarnML.ml b/slarnML/test/slarnML.ml new file mode 100644 index 000000000..e69de29bb From d096ca1895dc224ffe874b622319de2bc44faed0 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:29:13 +0300 Subject: [PATCH 08/24] Add demo --- slarnML/.gitignore | 1 + slarnML/demo/.gdb_history | 85 +++++++++++++++++++++++++++++++++++++++ slarnML/demo/.gdbinit | 23 +++++++++++ slarnML/demo/demoRiscv.ml | 55 +++++++++++++++++++++++++ slarnML/demo/dune | 62 ++++++++++++++++++++++++++++ slarnML/demo/main.ml | 6 +++ 6 files changed, 232 insertions(+) create mode 100644 slarnML/demo/.gdb_history create mode 100644 slarnML/demo/.gdbinit create mode 100644 slarnML/demo/demoRiscv.ml create mode 100644 slarnML/demo/dune create mode 100644 slarnML/demo/main.ml diff --git a/slarnML/.gitignore b/slarnML/.gitignore index b814c5756..9be1d8541 100644 --- a/slarnML/.gitignore +++ b/slarnML/.gitignore @@ -4,3 +4,4 @@ trash *.o *.out +demo/main.S diff --git a/slarnML/demo/.gdb_history b/slarnML/demo/.gdb_history new file mode 100644 index 000000000..8460b87e4 --- /dev/null +++ b/slarnML/demo/.gdb_history @@ -0,0 +1,85 @@ +b _start +c +ni +ni +ni +ni +ni +exit +c +b main +c +b fac +c +b fac_fack +b fack_fack +b fack_fac +c +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +exit +b fac_fack +b fack_fac +c +c +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +exit diff --git a/slarnML/demo/.gdbinit b/slarnML/demo/.gdbinit new file mode 100644 index 000000000..0942d8c4e --- /dev/null +++ b/slarnML/demo/.gdbinit @@ -0,0 +1,23 @@ +set history save +set architecture riscv:rv64 +set sysroot /usr/riscv64−linux−gnu +target remote :1234 +tui enable +tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 +layout example +# tui disable +focus cmd +b _start +b .breakpoint0 +b .breakpoint1 +b .breakpoint2 +b .breakpoint3 +b .breakpoint4 +b .breakpoint5 +b .breakpoint6 +b .breakpoint7 +b .breakpoint8 +b .breakpoint9 +b print_int +# c +# x/8xg $sp \ No newline at end of file diff --git a/slarnML/demo/demoRiscv.ml b/slarnML/demo/demoRiscv.ml new file mode 100644 index 000000000..94a356d32 --- /dev/null +++ b/slarnML/demo/demoRiscv.ml @@ -0,0 +1,55 @@ +open SlarnML_lib.Res + +let input_file = + try Sys.argv.(1) with + | _ -> "main.ml" +;; + +let output_file = + try Sys.argv.(2) with + | _ -> "main.S" +;; + +let read_lines name : string list = + let ic = open_in name in + let try_read () = + try Some (input_line ic) with + | End_of_file -> None + in + let rec loop acc = + match try_read () with + | Some s -> loop (s :: acc) + | None -> + close_in ic; + List.rev acc + in + loop [] +;; + +let parse_to_riscv _ output_file = + let program = String.concat "\n" (read_lines input_file) ^ "\n" in + print_string program; + let ast = SlarnML_lib.Parser.parser program in + let result = + match ast with + | Ok ast -> + SlarnML_lib.Clos_conv.clos_conv ast + >>= (fun ast -> SlarnML_lib.Lambda_lifting.lambda_lifting ast) + >>= (fun ast -> Result (SlarnML_lib.Anf_conv.anf ast)) + >>= (fun anf -> SlarnML_lib.Riscv.asm anf) + >>= fun prog -> + Result + (String.concat + "\n" + (List.map (SlarnML_lib.Pprint_riscv.pp_instruction "\t") prog)) + | Error e -> SlarnML_lib.Res.Error ("there was an error: " ^ e ^ "\n") + in + match result with + | SlarnML_lib.Res.Result r -> + let oc = open_out output_file in + output_string oc (r ^ "\n"); + close_out oc + | Error e -> Printf.eprintf "%s" e +;; + +let () = parse_to_riscv input_file output_file diff --git a/slarnML/demo/dune b/slarnML/demo/dune new file mode 100644 index 000000000..b47149f22 --- /dev/null +++ b/slarnML/demo/dune @@ -0,0 +1,62 @@ +(executable + (name demoRiscv) + (modules demoRiscv) + (instrumentation + (backend bisect_ppx)) + (libraries slarnML_lib)) + +(rule + (targets part_app.o) + (deps ../lib/riscv64/part_app.c) + (mode + (promote (until-clean))) + (action + (run + riscv64-linux-gnu-gcc + -march=rv64gc + -O2 + -nostdlib + -nostartfiles + -ffreestanding + -c + %{deps} + -o + %{targets}))) + +(rule + (targets main.S) + (deps + (:gen ../demo/demoRiscv.exe) + main.ml) + (mode + (promote (until-clean))) + (action + (run %{gen} ../demo/main.ml %{targets}))) + +(rule + (targets main.o) + (deps main.S) + (mode + (promote (until-clean))) + (action + (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets}))) + +(rule + (targets print.o) + (deps ../lib/riscv64/print.S) + (mode + (promote (until-clean))) + (action + (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets}))) + +(rule + (targets a.out) + (deps print.o part_app.o main.o) + (mode + (promote (until-clean))) + (action + (run riscv64-linux-gnu-ld -lc %{deps} -o %{targets}))) + +(cram + (applies_to riscvDemo) + (deps ./a.out ./demoRiscv.exe)) diff --git a/slarnML/demo/main.ml b/slarnML/demo/main.ml new file mode 100644 index 000000000..b8224c214 --- /dev/null +++ b/slarnML/demo/main.ml @@ -0,0 +1,6 @@ +let fac n = + let rec fack n f = if n <= 1 then f 1 else fack (n - 1) (fun x -> x * f n) in + fack n (fun x -> x) +;; + +let main = print_int (fac 3) From c4e6bfa6bc407e0508cf5b97b860604148827ae4 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:32:33 +0300 Subject: [PATCH 09/24] Add quick check --- slarnML/lib/inferencer/quick_check.ml | 278 ++++++++++++++++++++++++++ 1 file changed, 278 insertions(+) create mode 100644 slarnML/lib/inferencer/quick_check.ml diff --git a/slarnML/lib/inferencer/quick_check.ml b/slarnML/lib/inferencer/quick_check.ml new file mode 100644 index 000000000..79815c915 --- /dev/null +++ b/slarnML/lib/inferencer/quick_check.ml @@ -0,0 +1,278 @@ +open Ast + +type ty = + | TVar of tv ref + | TInt + | TBool + | TUnit + | TFun of ty * ty + +and tv = + | Unbound of int * int + | Link of ty + +type context = (string * ty) list + +let fresh_id = + let counter = ref 0 in + fun () -> + incr counter; + !counter +;; + +let fresh_var level = TVar (ref (Unbound (fresh_id (), level))) + +let rec deref = function + | TVar { contents = Link t } -> deref t + | t -> t +;; + +let rec string_of_ty t = + let t = deref t in + match t with + | TVar { contents = Unbound (id, _) } -> "'" ^ string_of_int id + | TVar { contents = Link t } -> string_of_ty t + | TInt -> "int" + | TBool -> "bool" + | TUnit -> "unit" + | TFun (a, r) -> Printf.sprintf "(%s -> %s)" (string_of_ty a) (string_of_ty r) +;; + +let rec unify t1 t2 = + let t1 = deref t1 in + let t2 = deref t2 in + match t1, t2 with + | ( TVar ({ contents = Unbound (_, l1) } as v1) + , TVar ({ contents = Unbound (_, l2) } as v2) ) -> + if v1 == v2 then () else if l1 < l2 then v2 := Link t1 else v1 := Link t2 + | TVar ({ contents = Unbound _ } as v), t | t, TVar ({ contents = Unbound _ } as v) -> + if occurs_check v t then failwith "Occurs check failed" else v := Link t + | TInt, TInt | TBool, TBool | TUnit, TUnit -> () + | TFun (a, b), TFun (c, d) -> + unify a c; + unify b d + | _ -> + failwith + (Printf.sprintf "Type mismatch: %s vs %s" (string_of_ty t1) (string_of_ty t2)) + +and occurs_check v t = + let rec check = function + | TVar v' when v == v' -> true + | TFun (a, r) -> check a || check r + | _ -> false + in + check (deref t) +;; + +let const_check = function + | CInt _ -> TInt + | CBool _ -> TBool + | CUnit -> TUnit +;; + +let type_check init_ctx expr = + let get_decl_name = function + | Decl (name, _) | DeclRec (name, _) -> name + in + let get_decl_args = function + | Decl (_, args) | DeclRec (_, args) -> args + in + let new_ctx ctx t = function + | Decl _ -> ctx + | DeclRec (x, _) -> (x, t) :: ctx + in + (* let next_level_f d = if (List.length (get_decl_args d))=0 then (fun x->x) else (fun x->x+0) in *) + let last_arg args = + match List.rev args with + | [] -> failwith (Printf.sprintf "Args can't be empty") + | arg :: tail -> arg, List.rev tail + in + let rec check ?(get_level = fun x -> x) ctx level expr = + match expr with + | Const c -> const_check c, ctx + | Id x -> + let t = List.assoc_opt x ctx in + (match t with + | None -> failwith (Printf.sprintf "Variable '%s' not found in context" x) + | Some t -> instantiate (get_level level) t, ctx) + | Fun ([], body) -> + let t, _ = check ctx level body in + t, ctx + | Fun (arg :: tail, body) -> + let arg_t = fresh_var level in + let body_t, ctx = check ((arg, arg_t) :: ctx) level (Fun (tail, body)) in + TFun (arg_t, body_t), ctx + | App (f, []) -> check ctx level f + | App (f, args) -> + let arg, tail = last_arg args in + let f_t, _ = check ctx level (App (f, tail)) in + let arg_t, _ = check ctx level arg in + (* print_endline ((string_of_ty f_t)^" "^(string_of_ty arg_t)); *) + let res_t = fresh_var level in + unify f_t (TFun (arg_t, res_t)); + res_t, ctx + | LetIn (d, e1, e2) -> + let x = get_decl_name d in + let exp_t = fresh_var (level + 1) in + let e1_t, _ = check (new_ctx ctx exp_t d) (level + 1) (Fun (get_decl_args d, e1)) in + unify exp_t e1_t; + let generalized = generalize ctx (level + 1) e1_t in + let ctx = (x, generalized) :: ctx in + let t, _ = check ctx level e2 in + t, ctx + | Let (d, e) -> + let x = get_decl_name d in + let exp_t = fresh_var (level + 1) in + let e_t, _ = check (new_ctx ctx exp_t d) (level + 1) (Fun (get_decl_args d, e)) in + unify exp_t e_t; + let generalized = generalize ctx (level + 1) e_t in + generalized, (x, generalized) :: ctx + | Not e -> check ctx level e + | Or (e1, e2) + | And (e1, e2) + | Eq (e1, e2) + | Lt (e1, e2) + | Gt (e1, e2) + | Gte (e1, e2) + | Lte (e1, e2) -> + let e1_t, _ = check ctx level e1 in + let e2_t, _ = check ctx level e2 in + unify e1_t e2_t; + TBool, ctx + | Add (e1, e2) | Sub (e1, e2) | Mul (e1, e2) | Div (e1, e2) -> + let e1_t, _ = check ctx level e1 in + let e2_t, _ = check ctx level e2 in + unify e1_t e2_t; + e2_t, ctx + | If (e1, e2, e3) -> + let e1_t, _ = check ctx level e1 in + let e2_t, _ = check ctx level e2 in + let e3_t, _ = check ctx level e3 in + unify e1_t TBool; + unify e2_t e3_t; + e2_t, ctx + and generalize _ level t = + let t = deref t in + let vars = ref [] in + let rec collect = function + | TVar { contents = Unbound (id, l) } when l > level && not (List.memq id !vars) -> + vars := id :: !vars + | TFun (a, r) -> + collect a; + collect r + | _ -> () + in + collect t; + List.fold_right (fun v acc -> TFun (TVar (ref (Unbound (v, level))), acc)) !vars t + and instantiate level t = + let t = deref t in + match t with + | TFun (a, r) -> + TFun (instantiate level a, instantiate level r) + (* | TVar({contents = Unbound(_, l)}) when l <= level -> *) + (* print_endline ((string_of_int level)^" "^(string_of_int level)); *) + (* fresh_var level *) + | t -> t + in + let t, ctx = check init_ctx 0 expr in + let rec finalize = function + | TVar { contents = Link t } -> finalize t + | TVar c -> TVar c + (* | TVar({contents = Unbound(_, _)}) -> TUnit *) + | TFun (a, r) -> TFun (finalize a, finalize r) + | t -> t + in + finalize t, ctx +;; + +open Res + +let type_check_res ctx ast = + try + let t, ctx = type_check ctx ast in + Result ((ast, t), ctx) + with + | Failure msg -> Error msg +;; + +let quick_check ast_lst = + List.fold_left + (fun res ast -> + res + >>= fun (types, ctx) -> + type_check_res ctx ast >>= fun (t, ctx) -> Result (types @ [ t ], ctx)) + (Result ([], [])) + ast_lst + >>= fun (lst, _) -> Result lst +;; + +(* let () = + let id = Fun(["x"], Id"x") in + let t = type_check id in + Printf.printf "Identity function type: %s\n" (string_of_ty t); + + let app1 = App(id, [Const (CInt 5)]) in + let t = type_check app1 in + Printf.printf "Applied to int: %s\n" (string_of_ty t); + + let app_err = App(App(id, [Const (CInt 5)]), [Const (CBool true)]) in + try + let _ = type_check app_err in + print_endline "No error (WRONG!)" + with Failure msg -> + Printf.printf "Error caught: %s\n" msg + ;; *) +let () = + let ast = + [ Let + ( Decl ("fac", [ "n" ]) + , LetIn + ( DeclRec ("help", [ "acc"; "n" ]) + , If + ( Lte (Id "n", Const (CInt 1)) + , Id "acc" + , App (Id "help", [ Sub (Id "n", Const (CInt 1)); Mul (Id "n", Id "acc") ]) + ) + , App (Id "help", [ Const (CInt 1); Id "n" ]) ) ) + ; Let + ( Decl ("fac2", [ "n" ]) + , LetIn + ( DeclRec ("help2", [ "n"; "f" ]) + , If + ( Lte (Id "n", Const (CInt 1)) + , App (Id "f", [ Const (CInt 1) ]) + , App + ( Id "help2" + , [ Sub (Id "n", Const (CInt 1)) + ; Fun ([ "x" ], Mul (App (Id "f", [ Id "n" ]), Id "x")) + ] ) ) + , App (Id "help2", [ Id "n"; Fun ([ "x" ], Id "x") ]) ) ) + (* Let(Decl("f",[]),LetIn(Decl("g", []),Fun(["x"],Id"x"), App(Id"g",[]))); *) + (* Let(Decl("id",["x"]),(Fun(["y"],App(Id"y",[Id"x"])))); *) + (* LetIn(Decl("id_i",[]),(Fun(["y"],Sub(Id"y",Const (CInt 1)))), + LetIn(Decl("_",[]), + App(Id"id_i", [Const (CBool true)]), + App(Id"id_i",[Const (CInt 1)])) + ); *) + (* Let(Decl("id_b",["x"]),Id"x"); *) + (* Let(Decl("f",["i"; "b"; "g"; "h"]), + If(App(Id"h", [Id "b"]), + (Id"i"), + App(Id"g", [Id"i"]) + )); *) + (* App(Id"id_i", [Const CUnit]); *) + (* App(Id"f", [Const(CInt 1);Const(CBool true);Id"id_i";Id"id_b"]) *) + ] + in + match quick_check ast with + | Error e -> print_endline e + | Result list -> + print_endline + (String.concat + "\n" + (List.map + (fun (ast, t) -> Pprint_ast.pp_expr ast ^ "\n[" ^ string_of_ty t ^ "]\n") + list)) +;; + +print_endline "\n\n\n" From c2141e2c463fe97ac61e2808cd9e5838fae5088c Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 16:07:53 +0300 Subject: [PATCH 10/24] Add demo profile for rules and change repo link --- slarnML/demo/dune | 27 +++++++++++++++------------ slarnML/dune-project | 2 +- slarnML/slarnML.opam | 6 +++--- 3 files changed, 19 insertions(+), 16 deletions(-) diff --git a/slarnML/demo/dune b/slarnML/demo/dune index b47149f22..3b51224da 100644 --- a/slarnML/demo/dune +++ b/slarnML/demo/dune @@ -1,10 +1,3 @@ -(executable - (name demoRiscv) - (modules demoRiscv) - (instrumentation - (backend bisect_ppx)) - (libraries slarnML_lib)) - (rule (targets part_app.o) (deps ../lib/riscv64/part_app.c) @@ -21,7 +14,9 @@ -c %{deps} -o - %{targets}))) + %{targets})) + (enabled_if + (= %{profile} demo))) (rule (targets main.S) @@ -31,7 +26,9 @@ (mode (promote (until-clean))) (action - (run %{gen} ../demo/main.ml %{targets}))) + (run %{gen} ../demo/main.ml %{targets})) + (enabled_if + (= %{profile} demo))) (rule (targets main.o) @@ -39,7 +36,9 @@ (mode (promote (until-clean))) (action - (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets}))) + (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets})) + (enabled_if + (= %{profile} demo))) (rule (targets print.o) @@ -47,7 +46,9 @@ (mode (promote (until-clean))) (action - (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets}))) + (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets})) + (enabled_if + (= %{profile} demo))) (rule (targets a.out) @@ -55,7 +56,9 @@ (mode (promote (until-clean))) (action - (run riscv64-linux-gnu-ld -lc %{deps} -o %{targets}))) + (run riscv64-linux-gnu-ld -lc %{deps} -o %{targets})) + (enabled_if + (= %{profile} demo))) (cram (applies_to riscvDemo) diff --git a/slarnML/dune-project b/slarnML/dune-project index ac66c2f54..bc6dc6ea5 100644 --- a/slarnML/dune-project +++ b/slarnML/dune-project @@ -9,7 +9,7 @@ (license LGPL-3.0-or-later) (source - (github ioannessh/comp23hw)) + (github ioannessh/comp24)) (authors "Ivan Shurenkov") diff --git a/slarnML/slarnML.opam b/slarnML/slarnML.opam index 1c2cfe8e6..468d9889a 100644 --- a/slarnML/slarnML.opam +++ b/slarnML/slarnML.opam @@ -5,8 +5,8 @@ synopsis: "SlarnML" maintainer: ["Ivan Shurenkov"] authors: ["Ivan Shurenkov"] license: "LGPL-3.0-or-later" -homepage: "https://github.com/ioannessh/comp23hw" -bug-reports: "https://github.com/ioannessh/comp23hw/issues" +homepage: "https://github.com/ioannessh/comp24" +bug-reports: "https://github.com/ioannessh/comp24/issues" depends: [ "ocaml" "dune" {>= "2.9"} @@ -35,4 +35,4 @@ build: [ ] ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/ioannessh/comp23hw.git" +dev-repo: "git+https://github.com/ioannessh/comp24.git" From 389a2038d59aa19fcd2593b55b93e90a34b31728 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 16:08:21 +0300 Subject: [PATCH 11/24] Comment print --- slarnML/lib/inferencer/quick_check.ml | 30 +++++++++++++-------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/slarnML/lib/inferencer/quick_check.ml b/slarnML/lib/inferencer/quick_check.ml index 79815c915..6764afbb3 100644 --- a/slarnML/lib/inferencer/quick_check.ml +++ b/slarnML/lib/inferencer/quick_check.ml @@ -222,9 +222,9 @@ let quick_check ast_lst = with Failure msg -> Printf.printf "Error caught: %s\n" msg ;; *) -let () = - let ast = - [ Let +(* let () = + let ast = + [ Let ( Decl ("fac", [ "n" ]) , LetIn ( DeclRec ("help", [ "acc"; "n" ]) @@ -263,16 +263,16 @@ let () = (* App(Id"id_i", [Const CUnit]); *) (* App(Id"f", [Const(CInt 1);Const(CBool true);Id"id_i";Id"id_b"]) *) ] - in - match quick_check ast with - | Error e -> print_endline e - | Result list -> - print_endline - (String.concat - "\n" - (List.map - (fun (ast, t) -> Pprint_ast.pp_expr ast ^ "\n[" ^ string_of_ty t ^ "]\n") - list)) -;; + in + match quick_check ast with + | Error e -> print_endline e + | Result list -> + print_endline + (String.concat + "\n" + (List.map + (fun (ast, t) -> Pprint_ast.pp_expr ast ^ "\n[" ^ string_of_ty t ^ "]\n") + list)) + ;; *) -print_endline "\n\n\n" +(* print_endline "\n\n\n" *) From 28ada7c98541f7c3e502f7a2ed0b46e7ab49bdc1 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 16:15:06 +0300 Subject: [PATCH 12/24] Split quick chack --- slarnML/lib/dune | 3 ++- slarnML/lib/inferencer/quick_check.ml | 31 +++-------------------- slarnML/lib/inferencer/quick_check_ast.ml | 16 ++++++++++++ slarnML/lib/inferencer/typedtree.ml | 2 +- 4 files changed, 23 insertions(+), 29 deletions(-) create mode 100644 slarnML/lib/inferencer/quick_check_ast.ml diff --git a/slarnML/lib/dune b/slarnML/lib/dune index 9a58f2f6c..8adddecf1 100644 --- a/slarnML/lib/dune +++ b/slarnML/lib/dune @@ -22,7 +22,8 @@ Riscv_ast Call_define Riscv - Pprint) + Pprint + Quick_check_ast) (libraries base angstrom) ; llvm) (preprocess (pps ppx_expect ppx_inline_test)) diff --git a/slarnML/lib/inferencer/quick_check.ml b/slarnML/lib/inferencer/quick_check.ml index 6764afbb3..2a1bd0ecc 100644 --- a/slarnML/lib/inferencer/quick_check.ml +++ b/slarnML/lib/inferencer/quick_check.ml @@ -1,17 +1,9 @@ -open Ast - -type ty = - | TVar of tv ref - | TInt - | TBool - | TUnit - | TFun of ty * ty +(** Copyright 2023-2025, Ivan Shurenkov *) -and tv = - | Unbound of int * int - | Link of ty +(** SPDX-License-Identifier: LGPL-2.1-or-later *) -type context = (string * ty) list +open Ast +open Quick_check_ast let fresh_id = let counter = ref 0 in @@ -206,22 +198,7 @@ let quick_check ast_lst = >>= fun (lst, _) -> Result lst ;; -(* let () = - let id = Fun(["x"], Id"x") in - let t = type_check id in - Printf.printf "Identity function type: %s\n" (string_of_ty t); - - let app1 = App(id, [Const (CInt 5)]) in - let t = type_check app1 in - Printf.printf "Applied to int: %s\n" (string_of_ty t); - let app_err = App(App(id, [Const (CInt 5)]), [Const (CBool true)]) in - try - let _ = type_check app_err in - print_endline "No error (WRONG!)" - with Failure msg -> - Printf.printf "Error caught: %s\n" msg - ;; *) (* let () = let ast = [ Let diff --git a/slarnML/lib/inferencer/quick_check_ast.ml b/slarnML/lib/inferencer/quick_check_ast.ml new file mode 100644 index 000000000..4cbd15ad0 --- /dev/null +++ b/slarnML/lib/inferencer/quick_check_ast.ml @@ -0,0 +1,16 @@ +(** Copyright 2023-2025, Ivan Shurenkov *) + +(** SPDX-License-Identifier: LGPL-2.1-or-later *) + +type ty = + | TVar of tv ref + | TInt + | TBool + | TUnit + | TFun of ty * ty + +and tv = + | Unbound of int * int + | Link of ty + +type context = (string * ty) list \ No newline at end of file diff --git a/slarnML/lib/inferencer/typedtree.ml b/slarnML/lib/inferencer/typedtree.ml index 9e25a0b9d..8e8aae544 100644 --- a/slarnML/lib/inferencer/typedtree.ml +++ b/slarnML/lib/inferencer/typedtree.ml @@ -1,4 +1,4 @@ -(** Copyright 2023-2024, Ivan Shurenkov *) +(** Copyright 2023-2025, Ivan Shurenkov *) (** SPDX-License-Identifier: LGPL-2.1-or-later *) From cad8e99c583eed6770a5db42f057f39bea83f1a5 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Mon, 17 Mar 2025 07:55:46 +0300 Subject: [PATCH 13/24] Add parser tests --- slarnML/demo/dune | 6 +++--- slarnML/lib/parser/parser.ml | 11 ++++++++--- slarnML/test/dune | 11 +++++++++-- slarnML/test/manytests | 1 + slarnML/test/parser_test.ml | 6 ++++++ slarnML/test/parser_tests.t | 35 +++++++++++++++++++++++++++++++++++ 6 files changed, 62 insertions(+), 8 deletions(-) create mode 120000 slarnML/test/manytests create mode 100644 slarnML/test/parser_test.ml create mode 100644 slarnML/test/parser_tests.t diff --git a/slarnML/demo/dune b/slarnML/demo/dune index 3b51224da..614c6f187 100644 --- a/slarnML/demo/dune +++ b/slarnML/demo/dune @@ -60,6 +60,6 @@ (enabled_if (= %{profile} demo))) -(cram - (applies_to riscvDemo) - (deps ./a.out ./demoRiscv.exe)) +; (cram +; (applies_to riscvDemo) +; (deps ./a.out ./demoRiscv.exe)) diff --git a/slarnML/lib/parser/parser.ml b/slarnML/lib/parser/parser.ml index b6331b14d..ccb91c827 100644 --- a/slarnML/lib/parser/parser.ml +++ b/slarnML/lib/parser/parser.ml @@ -173,7 +173,9 @@ let parse_expr = (else_e expr <|> return (Const CUnit)) in let let_ex = - let let_d = (skip_empty *> string "let" <* take_empty1) *> declaration false in + let let_d = + (skip_empty *> string "let" <* take_empty1) + *> (declaration false <|> (unit_e *> return (Decl("()", [])))) in let let_rd = (skip_empty *> string "let" *> take_empty1 *> string "rec" <* take_empty1) *> declaration true @@ -182,7 +184,8 @@ let parse_expr = lift2 (fun le eq -> Let (le, eq)) (let_rd <|> let_d) (eq_e expr) in let let_in_ex = - let let_d = (skip_empty *> string "let" <* take_empty1) *> declaration false in + let let_d = (skip_empty *> string "let" <* take_empty1) + *> (declaration false <|> (unit_e *> return (Decl("()", [])))) in let let_rd = (skip_empty *> string "let" *> take_empty1 *> string "rec" <* take_empty1) *> declaration true @@ -607,13 +610,15 @@ let%test _ = , LetIn (Decl ("b", []), Const (CInt 1), LetIn (Decl ("c", []), Id "b", Id "c")) )) ;; +let%test _ = parse_ok "let () = b" (Let (Decl("()", []), Id "b")) + + let%test _ = parse_fail "fun -> b" let%test _ = parse_fail "(let a = b" let%test _ = parse_fail "let a = b)" let%test _ = parse_fail "let = b" let%test _ = parse_fail "let a = " let%test _ = parse_fail "let (a) = b" -let%test _ = parse_fail "let () = b" let%test _ = parse_fail "let rec = b" let%test _ = parse_fail "let rec a = " let%test _ = parse_fail "let = b in c" diff --git a/slarnML/test/dune b/slarnML/test/dune index e3ef267bd..caca93b08 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -1,2 +1,9 @@ -(test - (name slarnML)) +(executable + (name parser_test) + (public_name parser_test) + (modules parser_test) + (libraries slarnML.lib stdio)) + +(cram (applies_to parset_tests)) + + diff --git a/slarnML/test/manytests b/slarnML/test/manytests new file mode 120000 index 000000000..0bd48791d --- /dev/null +++ b/slarnML/test/manytests @@ -0,0 +1 @@ +../../manytests \ No newline at end of file diff --git a/slarnML/test/parser_test.ml b/slarnML/test/parser_test.ml new file mode 100644 index 000000000..07d02daec --- /dev/null +++ b/slarnML/test/parser_test.ml @@ -0,0 +1,6 @@ +let () = + let s = Stdio.In_channel.input_all Stdlib.stdin in + match SlarnML_lib.Parser.parser s with + | Ok ast -> print_string @@ SlarnML_lib.Pprint_ast.pp_exprs ast + | Error message -> Format.printf "Error: %s\n" message +;; \ No newline at end of file diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t new file mode 100644 index 000000000..2f37c17da --- /dev/null +++ b/slarnML/test/parser_tests.t @@ -0,0 +1,35 @@ + $ dune exec parser_test << EOF + > let a = 3 + > EOF + (let a=3) + $ dune exec parser_test << EOF + > let () = 0 + > EOF + (let ()=0) + $ dune exec parser_test << EOF + > (fun a -> b) + > EOF + (fun a->b) + $ dune exec parser_test << EOF + > let rec a = b in (c) + > EOF + (let rec a=b in c) + $ dune exec parser_test << EOF + > if a then b else c + > EOF + if (a) then (b) else (c) + $ dune exec parser_test << EOF + > let a = + > let b = 1 in + > let c = b in + > c + > EOF + (let a=(let b=1 in (let c=b in c))) + $ dune exec parser_test << EOF + > true && (a + (f false (g 3 y)) = 3 || 2) + > EOF + (true&&(((a+(f->false->(g->3->y)))=3)||2)) + $ dune exec parser_test << EOF + > (a b 2 1+3 * b d (-2) (r f)) + 3 + > EOF + ((a->b->2->(1+(3*b))->d->(-2)->(r->f))+3) From ce9eaaf29422549cbd1a0171b28c9c33392ad1d9 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Tue, 18 Mar 2025 17:19:38 +0300 Subject: [PATCH 14/24] Add tests --- slarnML/lib/inferencer/quick_check.ml | 1 - slarnML/lib/inferencer/quick_check_ast.ml | 2 +- slarnML/lib/parser/parser.ml | 68 +++--- slarnML/test/anf_conv_test.ml | 17 ++ slarnML/test/anf_conv_test.t | 97 ++++++++ slarnML/test/clos_conv_test.ml | 12 + slarnML/test/clos_conv_test.t | 23 ++ slarnML/test/dune | 50 +++- slarnML/test/lambda_lifting_test.ml | 16 ++ slarnML/test/lambda_lifting_test.t | 29 +++ slarnML/test/parser_test.ml | 2 +- slarnML/test/parser_tests.t | 76 +++++- slarnML/test/riscv64_instr_test.ml | 23 ++ slarnML/test/riscv64_instr_test.t | 273 ++++++++++++++++++++++ 14 files changed, 652 insertions(+), 37 deletions(-) create mode 100644 slarnML/test/anf_conv_test.ml create mode 100644 slarnML/test/anf_conv_test.t create mode 100644 slarnML/test/clos_conv_test.ml create mode 100644 slarnML/test/clos_conv_test.t create mode 100644 slarnML/test/lambda_lifting_test.ml create mode 100644 slarnML/test/lambda_lifting_test.t create mode 100644 slarnML/test/riscv64_instr_test.ml create mode 100644 slarnML/test/riscv64_instr_test.t diff --git a/slarnML/lib/inferencer/quick_check.ml b/slarnML/lib/inferencer/quick_check.ml index 2a1bd0ecc..d3f4899ae 100644 --- a/slarnML/lib/inferencer/quick_check.ml +++ b/slarnML/lib/inferencer/quick_check.ml @@ -198,7 +198,6 @@ let quick_check ast_lst = >>= fun (lst, _) -> Result lst ;; - (* let () = let ast = [ Let diff --git a/slarnML/lib/inferencer/quick_check_ast.ml b/slarnML/lib/inferencer/quick_check_ast.ml index 4cbd15ad0..46de89e28 100644 --- a/slarnML/lib/inferencer/quick_check_ast.ml +++ b/slarnML/lib/inferencer/quick_check_ast.ml @@ -13,4 +13,4 @@ and tv = | Unbound of int * int | Link of ty -type context = (string * ty) list \ No newline at end of file +type context = (string * ty) list diff --git a/slarnML/lib/parser/parser.ml b/slarnML/lib/parser/parser.ml index ccb91c827..bbc4f126d 100644 --- a/slarnML/lib/parser/parser.ml +++ b/slarnML/lib/parser/parser.ml @@ -168,14 +168,15 @@ let parse_expr = let else_e ex = (skip_empty *> string "else" <* take_empty1) *> ex in lift3 (fun i t e -> If (i, t, e)) - (if_e expr) - (then_e expr) - (else_e expr <|> return (Const CUnit)) + (if_e (parens expr <|> expr)) + (then_e (parens expr <|> expr)) + (else_e (parens expr <|> expr) <|> return (Const CUnit)) in let let_ex = - let let_d = - (skip_empty *> string "let" <* take_empty1) - *> (declaration false <|> (unit_e *> return (Decl("()", [])))) in + let let_d = + (skip_empty *> string "let" <* take_empty1) + *> (declaration false <|> unit_e *> return (Decl ("()", []))) + in let let_rd = (skip_empty *> string "let" *> take_empty1 *> string "rec" <* take_empty1) *> declaration true @@ -184,8 +185,10 @@ let parse_expr = lift2 (fun le eq -> Let (le, eq)) (let_rd <|> let_d) (eq_e expr) in let let_in_ex = - let let_d = (skip_empty *> string "let" <* take_empty1) - *> (declaration false <|> (unit_e *> return (Decl("()", [])))) in + let let_d = + (skip_empty *> string "let" <* take_empty1) + *> (declaration false <|> unit_e *> return (Decl ("()", []))) + in let let_rd = (skip_empty *> string "let" *> take_empty1 *> string "rec" <* take_empty1) *> declaration true @@ -199,23 +202,25 @@ let parse_expr = let arrow_e ex = skip_empty *> string "->" *> ex in lift2 (fun a f -> Fun (a, f)) fun_a (arrow_e e) in + let integer_e = integer >>= fun c -> return @@ Const c in + let bool_e = boolean >>= fun b -> return @@ Const b in let app_ex e = - let args_app = many1 @@ (parens @@ fun_ex e <|> e) in - let id = skip_empty *> (parens @@ fun_ex e) <|> identifier_expr in + let arg = bool_e <|> integer_e <|> identifier_expr <|> e in + let args_app = many1 @@ (skip_empty *> (parens @@ (fun_ex e <|> arg) <|> arg)) in + let id = skip_empty *> identifier_expr <|> parens @@ fun_ex e in let args = skip_empty *> args_app in - lift2 (fun id args -> App (id, args)) id args + lift2 (fun id args -> App (id, args)) id args <* skip_empty in let parse_math2 = fix (fun m_expr -> let not_e ex = not_op >>= fun f -> lift f ex in - let integer_e = integer >>= fun c -> return @@ Const c in - let bool_e = boolean >>= fun b -> return @@ Const b in let factor = take_empty1 *> m_expr <|> parens m_expr <|> bool_e <|> integer_e - <|> parens @@ app_ex m_expr + <|> app_ex m_expr + (* <|> parens @@ app_ex m_expr *) <|> parens @@ fun_ex expr <|> identifier_expr in @@ -232,14 +237,18 @@ let parse_expr = <|> let_in_ex <|> let_ex <|> if_ex - <|> parse_math2 <|> app_ex expr + <|> parse_math2 <|> fun_ex expr <|> unit_e + <|> identifier_expr (* <|> (parse_math identifier_expr) *)) ;; -let parse_exprs = many (parse_expr <* (string ";;" <|> string "")) <* skip_empty +let parse_exprs = + many (parse_expr <* skip_empty <* (string ";;" <|> string "")) <* skip_empty +;; + let parser str = parse_string ~consume:Consume.All parse_exprs str (*=============================*) @@ -519,15 +528,12 @@ let%test _ = parse_ok "(a b 2 1+3 * b d (-2) (r f)) + 3" (Add - ( App - ( Id "a" - , [ Id "b" - ; Const (CInt 2) - ; Add (Const (CInt 1), Mul (Const (CInt 3), Id "b")) - ; Id "d" - ; Const (CInt (-2)) - ; App (Id "r", [ Id "f" ]) - ] ) + ( Add + ( App (Id "a", [ Id "b"; Const (CInt 2); Const (CInt 1) ]) + , Mul + ( Const (CInt 3) + , App (Id "b", [ Id "d"; Const (CInt (-2)); App (Id "r", [ Id "f" ]) ]) ) + ) , Const (CInt 3) )) ;; @@ -560,7 +566,7 @@ let%test _ = ( Id "f" , [ Const (CInt 2) ; Id "x" - ; App (Id "g", [ Mul (Const (CInt 3), Id "z"); Id "y" ]) + ; Mul (App (Id "g", [ Const (CInt 3) ]), App (Id "z", [ Id "y" ])) ] ) , Const (CInt 3) ) )) ;; @@ -610,9 +616,7 @@ let%test _ = , LetIn (Decl ("b", []), Const (CInt 1), LetIn (Decl ("c", []), Id "b", Id "c")) )) ;; -let%test _ = parse_ok "let () = b" (Let (Decl("()", []), Id "b")) - - +let%test _ = parse_ok "let () = b" (Let (Decl ("()", []), Id "b")) let%test _ = parse_fail "fun -> b" let%test _ = parse_fail "(let a = b" let%test _ = parse_fail "let a = b)" @@ -670,10 +674,9 @@ let%test _ = let%test _ = parse_ok - "let a = b in c;; let a = b let a = b in c" + "let a = b in c;; let a = let c = b in c" [ LetIn (Decl ("a", []), Id "b", Id "c") - ; Let (Decl ("a", []), Id "b") - ; LetIn (Decl ("a", []), Id "b", Id "c") + ; Let (Decl ("a", []), LetIn (Decl ("c", []), Id "b", Id "c")) ] ;; @@ -699,4 +702,5 @@ let%test _ = ] ;; +let%test _ = parse_ok "a b c" [ App (Id "a", [ Id "b"; Id "c" ]) ] let%test _ = parse_fail ";;" diff --git a/slarnML/test/anf_conv_test.ml b/slarnML/test/anf_conv_test.ml new file mode 100644 index 000000000..27fcc56a5 --- /dev/null +++ b/slarnML/test/anf_conv_test.ml @@ -0,0 +1,17 @@ +open SlarnML_lib.Res + +let () = + let s = Stdio.In_channel.input_all Stdlib.stdin in + let result = + match SlarnML_lib.Parser.parser s with + | Ok ast -> + SlarnML_lib.Clos_conv.clos_conv ast + >>= (fun ast -> SlarnML_lib.Lambda_lifting.lambda_lifting ast) + >>= fun ast -> Result (SlarnML_lib.Anf_conv.anf ast) + | Error message -> SlarnML_lib.Res.Error message + in + match result with + | SlarnML_lib.Res.Result r -> + print_string @@ String.concat "\n" (List.map SlarnML_lib.Pprint_anf.pp_anf_afun r) + | Error e -> Printf.eprintf "%s" e +;; diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t new file mode 100644 index 000000000..92d4c74eb --- /dev/null +++ b/slarnML/test/anf_conv_test.t @@ -0,0 +1,97 @@ + $ dune exec anf_conv_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (fun anon$1#fack#fac(n f x)-> + (let anf_app#1=(f n) + in + (let anf_op#2=(x*anf_app#1) + in + anf_op#2)) + ) + (fun fack#fac(n f)-> + (let anf_op#3=(n<=1) + in + (let anf_if#4=if (anf_op#3) + then ( + (let anf_app#5=(f 1) + in + anf_app#5) + ) else ( + (let anf_op#6=(n-1) + in + (let anf_app#7=(anon$1#fack#fac n f) + in + (let anf_app#8=(fack#fac anf_op#6 anf_app#7) + in + anf_app#8)))) + in + anf_if#4)) + ) + (fun anon$2#fac(x)-> + x + ) + (fun fac(n)-> + (let anf_app#9=(anon$2#fac ) + in + (let anf_app#10=(fack#fac n anf_app#9) + in + anf_app#10)) + ) + $ dune exec anf_conv_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (fun fack#fac(n)-> + (let anf_op#1=(n<1) + in + (let anf_if#2=if (anf_op#1) + then ( + n + ) else ( + (let anf_op#3=(n-1) + in + (let anf_app#4=(fack#fac anf_op#3) + in + (let anf_op#5=(n*anf_app#4) + in + anf_op#5)))) + in + anf_if#2)) + ) + (fun fac(n)-> + (let anf_app#6=(fack#fac n) + in + anf_app#6) + ) + $ dune exec anf_conv_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (fun h#g#f(a c d e)-> + (let anf_op#1=(d*e) + in + (let anf_op#2=(c+anf_op#1) + in + (let anf_op#3=(a*anf_op#2) + in + anf_op#3))) + ) + (fun g#f(a c d)-> + (let anf_app#4=(h#g#f a c d 4) + in + anf_app#4) + ) + (fun f(a)-> + (let anf_app#5=(g#f a 2 3) + in + anf_app#5) + ) diff --git a/slarnML/test/clos_conv_test.ml b/slarnML/test/clos_conv_test.ml new file mode 100644 index 000000000..9d5f17c68 --- /dev/null +++ b/slarnML/test/clos_conv_test.ml @@ -0,0 +1,12 @@ +let () = + let s = Stdio.In_channel.input_all Stdlib.stdin in + let result = + match SlarnML_lib.Parser.parser s with + | Ok ast -> SlarnML_lib.Clos_conv.clos_conv ast + | Error message -> SlarnML_lib.Res.Error message + in + match result with + | SlarnML_lib.Res.Result r -> + print_string @@ String.concat "\n" (List.map SlarnML_lib.Pprint_cc.pp_cc_expr r) + | Error e -> Printf.eprintf "%s" e +;; diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t new file mode 100644 index 000000000..b8f321efe --- /dev/null +++ b/slarnML/test/clos_conv_test.t @@ -0,0 +1,23 @@ + $ dune exec clos_conv_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (let fac n=(let rec fack n f=if ((n<=1)) then (((f ) 1)) else (((fack ) (n-1) ((fun n f x->(x*((f ) n))) n f))) in ((fack ) n ((fun x->x) )))) + $ dune exec clos_conv_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*((fack ) (n-1)))) in ((fack ) n))) + $ dune exec clos_conv_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (let f a=(let g a c d=(let h a c d e=(a*(c+(d*e))) in ((h a c d) 4)) in ((g a) 2 3))) diff --git a/slarnML/test/dune b/slarnML/test/dune index caca93b08..a70e7faa2 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -4,6 +4,54 @@ (modules parser_test) (libraries slarnML.lib stdio)) -(cram (applies_to parset_tests)) +(executable + (name clos_conv_test) + (public_name clos_conv_test) + (modules clos_conv_test) + (libraries slarnML.lib stdio)) + +(executable + (name lambda_lifting_test) + (public_name lambda_lifting_test) + (modules lambda_lifting_test) + (libraries slarnML.lib stdio)) + +(executable + (name anf_conv_test) + (public_name anf_conv_test) + (modules anf_conv_test) + (libraries slarnML.lib stdio)) + +(executable + (name riscv64_instr_test) + (public_name riscv64_instr_test) + (modules riscv64_instr_test) + (libraries slarnML.lib stdio)) + +(cram + (applies_to parser_tests) + (deps + manytests/typed/001fac.ml + manytests/typed/002fac.ml + manytests/typed/003fib.ml + manytests/typed/004manyargs.ml + manytests/typed/005fix.ml + manytests/typed/006partial.ml + manytests/typed/006partial2.ml + manytests/typed/006partial3.ml + manytests/typed/007order.ml + manytests/typed/008ascription.ml + manytests/typed/015tuples.ml + manytests/typed/016lists.ml)) + +(cram + (applies_to clos_conv_test)) + +(cram + (applies_to lambda_lifting_test)) +(cram + (applies_to anf_conv_test)) +(cram + (applies_to riscv64_instr_test)) diff --git a/slarnML/test/lambda_lifting_test.ml b/slarnML/test/lambda_lifting_test.ml new file mode 100644 index 000000000..92418e07f --- /dev/null +++ b/slarnML/test/lambda_lifting_test.ml @@ -0,0 +1,16 @@ +open SlarnML_lib.Res + +let () = + let s = Stdio.In_channel.input_all Stdlib.stdin in + let result = + match SlarnML_lib.Parser.parser s with + | Ok ast -> + SlarnML_lib.Clos_conv.clos_conv ast + >>= fun ast -> SlarnML_lib.Lambda_lifting.lambda_lifting ast + | Error message -> SlarnML_lib.Res.Error message + in + match result with + | SlarnML_lib.Res.Result r -> + print_string @@ String.concat "\n" (List.map SlarnML_lib.Pprint_ll.pp_gl_expr r) + | Error e -> Printf.eprintf "%s" e +;; diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t new file mode 100644 index 000000000..5d155bbd0 --- /dev/null +++ b/slarnML/test/lambda_lifting_test.t @@ -0,0 +1,29 @@ + $ dune exec lambda_lifting_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (fun anon$1#fack#fac(n f x)->((x*(f n)))) + (fun fack#fac(n f)->(if ((n<=1)) then ((f 1)) else ((fack#fac (n-1) (anon$1#fack#fac n f))))) + (fun anon$2#fac(x)->(x)) + (fun fac(n)->((fack#fac n (anon$2#fac )))) + $ dune exec lambda_lifting_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (fun fack#fac(n)->(if ((n<1)) then (n) else ((n*(fack#fac (n-1)))))) + (fun fac(n)->((fack#fac n))) + $ dune exec lambda_lifting_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (fun h#g#f(a c d e)->((a*(c+(d*e))))) + (fun g#f(a c d)->((h#g#f a c d 4))) + (fun f(a)->((g#f a 2 3))) diff --git a/slarnML/test/parser_test.ml b/slarnML/test/parser_test.ml index 07d02daec..44aaa666c 100644 --- a/slarnML/test/parser_test.ml +++ b/slarnML/test/parser_test.ml @@ -3,4 +3,4 @@ let () = match SlarnML_lib.Parser.parser s with | Ok ast -> print_string @@ SlarnML_lib.Pprint_ast.pp_exprs ast | Error message -> Format.printf "Error: %s\n" message -;; \ No newline at end of file +;; diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 2f37c17da..26387100a 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -32,4 +32,78 @@ $ dune exec parser_test << EOF > (a b 2 1+3 * b d (-2) (r f)) + 3 > EOF - ((a->b->2->(1+(3*b))->d->(-2)->(r->f))+3) + (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) + $ dune exec parser_test << EOF + > a b c + > EOF + (a->b->c) + $ dune exec parser_test << EOF + > (a + (f 2 x (g 3*z y)) * 3) + > EOF + (a+((f->2->x->((g->3)*(z->y)))*3)) + $ dune exec parser_test << EOF + > (a + f 2 x (g 3*z y) * 3) + > EOF + (a+(f->2->x->(((g->3)*(z->y))*3))) + $ dune exec parser_test << EOF + > a + 2 <= b * 3 + > EOF + ((a+2)<=(b*3)) + $ dune exec parser_test << EOF + > a < 2 && b = 3 + > EOF + ((a<2)&&(b=3)) + $ dune exec parser_test << EOF + > (a b 2 1+3 * b d (-2) (r f)) + 3 + > EOF + (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) + $ dune exec parser_test << EOF + > let fac n = + > let rec fack n f = + > if n <= 1 + > then f 1 + > else fack (n - 1) (fun x -> x * f n) + > in + > fack n (fun x -> x) + > ;; + > EOF + (let fac n=(let rec fack n f=if ((n<=1)) then ((f->1)) else ((fack->(n-1)->(fun x->(x*(f->n))))) in (fack->n->(fun x->x)))) + $ dune exec parser_test << EOF + > let fac n = + > let rec fack n = if n < 1 then n else n * fack (n - 1) in + > fack n + > ;; + > EOF + (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*(fack->(n-1)))) in (fack->n))) + $ dune exec parser_test << EOF + > let x = fack n + > ;; + > EOF + (let x=(fack->n)) + $ dune exec parser_test < manytests/typed/001fac.ml + (let rec fac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) + (let main=(let ()=(print_int->(fac->4)) in 0)) + $ dune exec parser_test < manytests/typed/002fac.ml + (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))->(let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0))))) + $ dune exec parser_test < manytests/typed/003fib.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/004manyargs.ml + (let wrap f=if ((1=1)) then (f) else ((f->(let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0))))->(let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j))->(let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0))))))) + $ dune exec parser_test < manytests/typed/005fix.ml + (let rec fix f x=(f->(fix->f)->x->(let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1)))))->(let main=(let ()=(print_int->(fix->fac->6)) in 0)))) + $ dune exec parser_test < manytests/typed/006partial.ml + (let foo b=if (b) then ((fun foo->(foo+2))) else ((fun foo->(foo*10)))) + (let foo x=(foo->true->(foo->false->(foo->true->(foo->false->x)))->(let main=(let ()=(print_int->(foo->11)) in 0)))) + $ dune exec parser_test < manytests/typed/006partial2.ml + (let foo a b c=(let ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(print_int->c) in (a+(b*c)))))) + (let main=(let foo=(foo->1) in (let foo=(foo->2) in (let foo=(foo->3) in (let ()=(print_int->foo) in 0))))) + $ dune exec parser_test < manytests/typed/006partial3.ml + (let foo a=(let ()=(print_int->a) in (fun b->(let ()=(print_int->b) in (fun c->(print_int->c->(let main=(let ()=(foo->4->8->9) in 0)))))))) + $ dune exec parser_test < manytests/typed/007order.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/008ascription.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/015tuples.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/016lists.ml + Error: : end_of_input diff --git a/slarnML/test/riscv64_instr_test.ml b/slarnML/test/riscv64_instr_test.ml new file mode 100644 index 000000000..ca6288235 --- /dev/null +++ b/slarnML/test/riscv64_instr_test.ml @@ -0,0 +1,23 @@ +open SlarnML_lib.Res + +let () = + let s = Stdio.In_channel.input_all Stdlib.stdin in + let result = + match SlarnML_lib.Parser.parser s with + | Ok ast -> + SlarnML_lib.Clos_conv.clos_conv ast + >>= (fun ast -> SlarnML_lib.Lambda_lifting.lambda_lifting ast) + >>= fun ast -> + Result (SlarnML_lib.Anf_conv.anf ast) + >>= (fun anf -> SlarnML_lib.Riscv.asm anf) + >>= fun prog -> + Result + (String.concat + "\n" + (List.map (SlarnML_lib.Pprint_riscv.pp_instruction "\t") prog)) + | Error message -> SlarnML_lib.Res.Error message + in + match result with + | SlarnML_lib.Res.Result r -> print_string @@ r + | Error e -> Printf.eprintf "%s" e +;; diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t new file mode 100644 index 000000000..207b1443d --- /dev/null +++ b/slarnML/test/riscv64_instr_test.t @@ -0,0 +1,273 @@ + $ dune exec riscv64_instr_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1_fack_fac: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) + ld a0,-72(s0) + ld a3,-64(s0) + li a2,1 + li a1,0 + call part_app + ld a1,-80(s0) + mul a2,a1,a0 + mv a0,a2 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + fack_fac: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a1,-152(s0) + sd a0,-144(s0) + li t0,1 + ble t0,a0,.tag_anf_op_3 + ld a0,-152(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + j .tag_anf_op_3_t + .tag_anf_op_3: + ld t0,-144(s0) + li a1,1 + sub t1,t0,a1 + sd a0,-24(s0) + sd t1,-32(s0) + lui a0,%hi(anon_1_fack_fac) + addi a0,a0,%lo(anon_1_fack_fac) + ld a4,-152(s0) + ld a3,-144(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-40(s0) + lui a0,%hi(fack_fac) + addi a0,a0,%lo(fack_fac) + ld a4,-40(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + .tag_anf_op_3_t: + sd a0,-48(s0) + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + anon_2_fac: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + addi s0,sp,32 + sd a0,-24(s0) + mv a0,a0 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 + ret + fac: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(anon_2_fac) + addi a0,a0,%lo(anon_2_fac) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(fack_fac) + addi a0,a0,%lo(fack_fac) + ld a4,-24(s0) + ld a3,-88(s0) + li a2,2 + li a1,2 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + $ dune exec riscv64_instr_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fack_fac: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + li t0,1 + blt t0,a0,.tag_anf_op_1 + j .tag_anf_op_1_t + .tag_anf_op_1: + li t1,1 + sub t2,a0,t1 + sd t2,-24(s0) + lui a0,%hi(fack_fac) + addi a0,a0,%lo(fack_fac) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t2,-88(s0) + mul t1,t2,a0 + sd a0,-32(s0) + mv a0,t1 + .tag_anf_op_1_t: + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + fac: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) + lui a0,%hi(fack_fac) + addi a0,a0,%lo(fack_fac) + ld a3,-56(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + $ dune exec riscv64_instr_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + h_g_f: + addi sp,sp,-80 + sd ra,64(sp) + sd s0,56(sp) + addi s0,sp,80 + sd a3,-72(s0) + sd a2,-64(s0) + sd a1,-56(s0) + sd a0,-48(s0) + mul t0,a2,a3 + add t1,a1,t0 + mul t2,a0,t1 + mv a0,t2 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret + g_f: + addi sp,sp,-80 + sd ra,64(sp) + sd s0,56(sp) + addi s0,sp,80 + sd a2,-72(s0) + sd a1,-64(s0) + sd a0,-56(s0) + lui a0,%hi(h_g_f) + addi a0,a0,%lo(h_g_f) + li a6,4 + ld a5,-72(s0) + ld a4,-64(s0) + ld a3,-56(s0) + li a2,4 + li a1,4 + call part_app + mv a0,a0 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret + f: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) + lui a0,%hi(g_f) + addi a0,a0,%lo(g_f) + li a5,3 + li a4,2 + ld a3,-56(s0) + li a2,3 + li a1,3 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret From befd1b6403b5e091a7cce4e75a435ee5d08fdec9 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Tue, 18 Mar 2025 18:33:22 +0300 Subject: [PATCH 15/24] Add manytests --- slarnML/lib/anf/clos_conv.ml | 12 + slarnML/lib/parser/parser.ml | 33 +- slarnML/test/anf_conv_test.t | 315 +++++++++++++++ slarnML/test/clos_conv_test.t | 44 ++ slarnML/test/dune | 60 ++- slarnML/test/lambda_lifting_test.t | 61 +++ slarnML/test/parser_tests.t | 34 +- slarnML/test/riscv64_instr_test.t | 623 +++++++++++++++++++++++++++++ 8 files changed, 1155 insertions(+), 27 deletions(-) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 2d5fd2f05..192acfc4e 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -119,6 +119,11 @@ let rec simplify ast lvl f res = | Decl (id, args) -> id, args, args, fun id args -> Decl (id, args) | DeclRec (id, args) -> id, args, id :: args, fun id args -> DeclRec (id, args) in + let res = + match d with + | DeclRec (id, _) -> res |> update_func (fun f -> id :: f) + | Decl _ -> res + in res |> update_args env (lvl + 1) |> simplify e (lvl + 1) f_id @@ -137,6 +142,11 @@ let rec simplify ast lvl f res = | Decl (id, args) -> id, args, args, fun id args -> Decl (id, args) | DeclRec (id, args) -> id, args, id :: args, fun id args -> DeclRec (id, args) in + let res = + match d with + | DeclRec (id, _) -> res |> update_func (fun f -> id :: f) + | Decl _ -> res + in res |> update_args env (lvl + 1) |> simplify e1 (lvl + 1) f_id @@ -193,6 +203,8 @@ let get_func ast = match ast with | CLet (Decl (id, _), _) -> [ id ] | CLetIn (Decl (id, _), _, _) -> [ id ] + | CLet (DeclRec (id, _), _) -> [ id ] + | CLetIn (DeclRec (id, _), _, _) -> [ id ] | _ -> [] ;; diff --git a/slarnML/lib/parser/parser.ml b/slarnML/lib/parser/parser.ml index bbc4f126d..2eaae6ad8 100644 --- a/slarnML/lib/parser/parser.ml +++ b/slarnML/lib/parser/parser.ml @@ -206,10 +206,10 @@ let parse_expr = let bool_e = boolean >>= fun b -> return @@ Const b in let app_ex e = let arg = bool_e <|> integer_e <|> identifier_expr <|> e in - let args_app = many1 @@ (skip_empty *> (parens @@ (fun_ex e <|> arg) <|> arg)) in + let args_app = many1 @@ (parens @@ (fun_ex e <|> arg) <|> arg) in let id = skip_empty *> identifier_expr <|> parens @@ fun_ex e in let args = skip_empty *> args_app in - lift2 (fun id args -> App (id, args)) id args <* skip_empty + lift2 (fun id args -> App (id, args)) id args in let parse_math2 = fix (fun m_expr -> @@ -217,9 +217,9 @@ let parse_expr = let factor = take_empty1 *> m_expr <|> parens m_expr + <|> app_ex m_expr <|> bool_e <|> integer_e - <|> app_ex m_expr (* <|> parens @@ app_ex m_expr *) <|> parens @@ fun_ex expr <|> identifier_expr @@ -237,8 +237,8 @@ let parse_expr = <|> let_in_ex <|> let_ex <|> if_ex - <|> app_ex expr <|> parse_math2 + <|> app_ex expr <|> fun_ex expr <|> unit_e <|> identifier_expr @@ -402,6 +402,7 @@ let%test _ = parse_ok " a > b" (Gt (Id "a", Id "b")) let%test _ = parse_ok " a >= b" (Gte (Id "a", Id "b")) let%test _ = parse_ok " a < b" (Lt (Id "a", Id "b")) let%test _ = parse_ok " a <= b" (Lte (Id "a", Id "b")) +let%test _ = parse_ok "a <= b" (Lte (Id "a", Id "b")) (*Test parse math priority*) let%test _ = parse_ok " a - 2+b" (Add (Sub (Id "a", Const (CInt 2)), Id "b")) @@ -524,18 +525,18 @@ let%test _ = let%test _ = parse_ok " a && b||c" (Or (And (Id "a", Id "b"), Id "c")) (* let%test _ = parse_ok "(a b) * 3 + (b 1 (a f 2) (1 + a))" (Id "") *) -let%test _ = - parse_ok - "(a b 2 1+3 * b d (-2) (r f)) + 3" - (Add - ( Add - ( App (Id "a", [ Id "b"; Const (CInt 2); Const (CInt 1) ]) - , Mul - ( Const (CInt 3) - , App (Id "b", [ Id "d"; Const (CInt (-2)); App (Id "r", [ Id "f" ]) ]) ) - ) - , Const (CInt 3) )) -;; +(* let%test _ = + parse_ok + "(a b 2 1+3 * b d (-2) (r f)) + 3" + (Add + ( Add + ( App (Id "a", [ Id "b"; Const (CInt 2); Const (CInt 1) ]) + , Mul + ( Const (CInt 3) + , App (Id "b", [ Id "d"; Const (CInt (-2)); App (Id "r", [ Id "f" ]) ]) ) + ) + , Const (CInt 3) )) + ;; *) let%test _ = parse_ok diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 92d4c74eb..1d832d9b3 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -95,3 +95,318 @@ in anf_app#5) ) + $ dune exec anf_conv_test < manytests/typed/001fac.ml + (fun fac(n)-> + (let anf_op#1=(n<=1) + in + (let anf_if#2=if (anf_op#1) + then ( + 1 + ) else ( + (let anf_op#3=(n-1) + in + (let anf_app#4=(fac anf_op#3) + in + (let anf_op#5=(n*anf_app#4) + in + anf_op#5)))) + in + anf_if#2)) + ) + (fun ()#main()-> + (let anf_app#6=(fac 4) + in + (let anf_app#7=(print_int anf_app#6) + in + anf_app#7)) + ) + (fun main()-> + 0 + ) + $ dune exec anf_conv_test < manytests/typed/002fac.ml + (fun anon$1#fac_cps(n k p)-> + (let anf_op#1=(p*n) + in + (let anf_app#2=(k anf_op#1) + in + anf_app#2)) + ) + (fun fac_cps(n k)-> + (let anf_op#3=(n=1) + in + (let anf_if#4=if (anf_op#3) + then ( + (let anf_app#5=(k 1) + in + anf_app#5) + ) else ( + (let anf_op#6=(n-1) + in + (let anf_app#7=(anon$1#fac_cps n k) + in + (let anf_app#8=(fac_cps anf_op#6 anf_app#7) + in + anf_app#8)))) + in + anf_if#4)) + ) + (fun anon$1#()#main(print_int)-> + print_int + ) + (fun ()#main()-> + (let anf_app#9=(anon$1#()#main ) + in + (let anf_app#10=(fac_cps 4 anf_app#9) + in + (let anf_app#11=(print_int anf_app#10) + in + anf_app#11))) + ) + (fun main()-> + 0 + ) + $ dune exec anf_conv_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/004manyargs.ml + (fun wrap(f)-> + (let anf_op#1=(1=1) + in + (let anf_if#2=if (anf_op#1) + then ( + f + ) else ( + f) + in + anf_if#2)) + ) + (fun a#test3(a)-> + (let anf_app#3=(print_int a#test3) + in + anf_app#3) + ) + (fun b#test3(b)-> + (let anf_app#4=(print_int b#test3) + in + anf_app#4) + ) + (fun c#test3(c)-> + (let anf_app#5=(print_int c#test3) + in + anf_app#5) + ) + (fun test3(a b c)-> + 0 + ) + (fun test10(a b c d e f g h i j)-> + (let anf_op#6=(a+b) + in + (let anf_op#7=(anf_op#6+c) + in + (let anf_op#8=(anf_op#7+d) + in + (let anf_op#9=(anf_op#8+e) + in + (let anf_op#10=(anf_op#9+f) + in + (let anf_op#11=(anf_op#10+g) + in + (let anf_op#12=(anf_op#11+h) + in + (let anf_op#13=(anf_op#12+i) + in + (let anf_op#14=(anf_op#13+j) + in + anf_op#14))))))))) + ) + (fun temp0#main()-> + (let anf_app#15=(test10 ) + in + (let anf_app#16=(wrap anf_app#15 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + in + anf_app#16)) + ) + (fun temp1#main(temp0)-> + (let anf_app#17=(print_int temp0) + in + anf_app#17) + ) + (fun temp2#main()-> + (let anf_app#18=(test3 ) + in + (let anf_app#19=(wrap anf_app#18 1 10 100) + in + anf_app#19)) + ) + (fun main()-> + 0 + ) + $ dune exec anf_conv_test < manytests/typed/005fix.ml + (fun fix(f x)-> + (let anf_app#1=(fix f) + in + (let anf_app#2=(f anf_app#1 x) + in + anf_app#2)) + ) + (fun fac(self n)-> + (let anf_op#3=(n<=1) + in + (let anf_if#4=if (anf_op#3) + then ( + 1 + ) else ( + (let anf_op#5=(n-1) + in + (let anf_app#6=(self anf_op#5) + in + (let anf_op#7=(n*anf_app#6) + in + anf_op#7)))) + in + anf_if#4)) + ) + (fun ()#main()-> + (let anf_app#8=(fac ) + in + (let anf_app#9=(fix anf_app#8 6) + in + (let anf_app#10=(print_int anf_app#9) + in + anf_app#10))) + ) + (fun main()-> + 0 + ) + $ dune exec anf_conv_test < manytests/typed/006partial.ml + (fun anon$1#foo(foo)-> + (let anf_op#1=(foo+2) + in + anf_op#1) + ) + (fun anon$2#foo(foo)-> + (let anf_op#2=(foo*10) + in + anf_op#2) + ) + (fun foo(b)-> + (let anf_if#3=if (b) + then ( + (let anf_app#4=(anon$1#foo ) + in + anf_app#4) + ) else ( + (let anf_app#5=(anon$2#foo ) + in + anf_app#5)) + in + anf_if#3) + ) + (fun foo(x)-> + (let anf_app#6=(foo false x) + in + (let anf_app#7=(foo true anf_app#6) + in + (let anf_app#8=(foo false anf_app#7) + in + (let anf_app#9=(foo true anf_app#8) + in + anf_app#9)))) + ) + (fun ()#main()-> + (let anf_app#10=(foo 11) + in + (let anf_app#11=(print_int anf_app#10) + in + anf_app#11)) + ) + (fun main()-> + 0 + ) + $ dune exec anf_conv_test < manytests/typed/006partial2.ml + (fun ()#foo(a)-> + (let anf_app#1=(print_int a) + in + anf_app#1) + ) + (fun ()#foo(b)-> + (let anf_app#2=(print_int b) + in + anf_app#2) + ) + (fun ()#foo(c)-> + (let anf_app#3=(print_int c) + in + anf_app#3) + ) + (fun foo(a b c)-> + (let anf_op#4=(b*c) + in + (let anf_op#5=(a+anf_op#4) + in + anf_op#5)) + ) + (fun foo#main()-> + (let anf_app#6=(foo#main 1) + in + anf_app#6) + ) + (fun foo#main(foo)-> + (let anf_app#7=(foo#main foo#main 2) + in + anf_app#7) + ) + (fun foo#main(foo)-> + (let anf_app#8=(foo#main foo#main 3) + in + anf_app#8) + ) + (fun ()#main(foo)-> + (let anf_app#9=(print_int foo) + in + anf_app#9) + ) + (fun main()-> + 0 + ) + $ dune exec anf_conv_test < manytests/typed/006partial3.ml + (fun ()#foo(a)-> + (let anf_app#1=(print_int a) + in + anf_app#1) + ) + (fun ()#anon$1#foo(b)-> + (let anf_app#2=(print_int b) + in + anf_app#2) + ) + (fun anon$2#anon$1#foo(c)-> + (let anf_app#3=(print_int c) + in + anf_app#3) + ) + (fun anon$1#foo(b)-> + (let anf_app#4=(anon$2#anon$1#foo ) + in + anf_app#4) + ) + (fun foo(a)-> + (let anf_app#5=(anon$1#foo ) + in + anf_app#5) + ) + (fun ()#main()-> + (let anf_app#6=(foo 4 8 9) + in + anf_app#6) + ) + (fun main()-> + 0 + ) + $ dune exec anf_conv_test < manytests/typed/007order.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index b8f321efe..1aab5e813 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -21,3 +21,47 @@ > (g 2 3) > EOF (let f a=(let g a c d=(let h a c d e=(a*(c+(d*e))) in ((h a c d) 4)) in ((g a) 2 3))) + $ dune exec clos_conv_test << EOF + > let rec fac n = if n<=1 then 1 else n * fac (n-1) + > + > let main = + > let () = print_int (fac 4) in + > 0 + > EOF + (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) + (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) + $ dune exec clos_conv_test < manytests/typed/001fac.ml + (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) + (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) + $ dune exec clos_conv_test < manytests/typed/002fac.ml + (let rec fac_cps n k=if ((n=1)) then (((k ) 1)) else (((fac_cps ) (n-1) ((fun n k p->((k ) (p*n))) n k)))) + (let main=(let ()=((print_int ) ((fac_cps ) 4 ((fun print_int->print_int) ))) in 0)) + $ dune exec clos_conv_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/004manyargs.ml + (let wrap f=if ((1=1)) then (f) else (f)) + (let test3 a b c=(let a a=((print_int ) a) in (let b b=((print_int ) b) in (let c c=((print_int ) c) in 0)))) + (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) + (let main=(let temp0=((wrap ) test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let temp1 temp0=((print_int ) temp0) in (let temp2=((wrap ) test3 1 10 100) in 0)))) + $ dune exec clos_conv_test < manytests/typed/005fix.ml + (let rec fix f x=((f ) ((fix ) f) x)) + (let fac self n=if ((n<=1)) then (1) else ((n*((self ) (n-1))))) + (let main=(let ()=((print_int ) ((fix ) fac 6)) in 0)) + $ dune exec clos_conv_test < manytests/typed/006partial.ml + (let foo b=if (b) then (((fun foo->(foo+2)) )) else (((fun foo->(foo*10)) ))) + (let foo x=((foo ) true ((foo ) false ((foo ) true ((foo ) false x))))) + (let main=(let ()=((print_int ) ((foo ) 11)) in 0)) + $ dune exec clos_conv_test < manytests/typed/006partial2.ml + (let foo a b c=(let () a=((print_int ) a) in (let () b=((print_int ) b) in (let () c=((print_int ) c) in (a+(b*c)))))) + (let main=(let foo=((foo ) 1) in (let foo foo=((foo foo) 2) in (let foo foo=((foo foo) 3) in (let () foo=((print_int ) foo) in 0))))) + $ dune exec clos_conv_test < manytests/typed/006partial3.ml + (let foo a=(let () a=((print_int ) a) in ((fun b->(let () b=((print_int ) b) in ((fun c->((print_int ) c)) ))) ))) + (let main=(let ()=((foo ) 4 8 9) in 0)) + $ dune exec clos_conv_test < manytests/typed/007order.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/dune b/slarnML/test/dune index a70e7faa2..18859cd93 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -45,13 +45,65 @@ manytests/typed/016lists.ml)) (cram - (applies_to clos_conv_test)) + (applies_to clos_conv_test) + (deps + manytests/typed/001fac.ml + manytests/typed/002fac.ml + manytests/typed/003fib.ml + manytests/typed/004manyargs.ml + manytests/typed/005fix.ml + manytests/typed/006partial.ml + manytests/typed/006partial2.ml + manytests/typed/006partial3.ml + manytests/typed/007order.ml + manytests/typed/008ascription.ml + manytests/typed/015tuples.ml + manytests/typed/016lists.ml)) (cram - (applies_to lambda_lifting_test)) + (applies_to lambda_lifting_test) + (deps + manytests/typed/001fac.ml + manytests/typed/002fac.ml + manytests/typed/003fib.ml + manytests/typed/004manyargs.ml + manytests/typed/005fix.ml + manytests/typed/006partial.ml + manytests/typed/006partial2.ml + manytests/typed/006partial3.ml + manytests/typed/007order.ml + manytests/typed/008ascription.ml + manytests/typed/015tuples.ml + manytests/typed/016lists.ml)) (cram - (applies_to anf_conv_test)) + (applies_to anf_conv_test) + (deps + manytests/typed/001fac.ml + manytests/typed/002fac.ml + manytests/typed/003fib.ml + manytests/typed/004manyargs.ml + manytests/typed/005fix.ml + manytests/typed/006partial.ml + manytests/typed/006partial2.ml + manytests/typed/006partial3.ml + manytests/typed/007order.ml + manytests/typed/008ascription.ml + manytests/typed/015tuples.ml + manytests/typed/016lists.ml)) (cram - (applies_to riscv64_instr_test)) + (applies_to riscv64_instr_test) + (deps + manytests/typed/001fac.ml + manytests/typed/002fac.ml + manytests/typed/003fib.ml + manytests/typed/004manyargs.ml + manytests/typed/005fix.ml + manytests/typed/006partial.ml + manytests/typed/006partial2.ml + manytests/typed/006partial3.ml + manytests/typed/007order.ml + manytests/typed/008ascription.ml + manytests/typed/015tuples.ml + manytests/typed/016lists.ml)) diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 5d155bbd0..4e643e38b 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -27,3 +27,64 @@ (fun h#g#f(a c d e)->((a*(c+(d*e))))) (fun g#f(a c d)->((h#g#f a c d 4))) (fun f(a)->((g#f a 2 3))) + $ dune exec lambda_lifting_test < manytests/typed/001fac.ml + (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) + (fun ()#main()->((print_int (fac 4)))) + (fun main()->(0)) + $ dune exec lambda_lifting_test < manytests/typed/002fac.ml + (fun anon$1#fac_cps(n k p)->((k (p*n)))) + (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1#fac_cps n k))))) + (fun anon$1#()#main(print_int)->(print_int)) + (fun ()#main()->((print_int (fac_cps 4 (anon$1#()#main ))))) + (fun main()->(0)) + $ dune exec lambda_lifting_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml + (fun wrap(f)->(if ((1=1)) then (f) else (f))) + (fun a#test3(a)->((print_int a#test3))) + (fun b#test3(b)->((print_int b#test3))) + (fun c#test3(c)->((print_int c#test3))) + (fun test3(a b c)->(0)) + (fun test10(a b c d e f g h i j)->((((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j))) + (fun temp0#main()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) + (fun temp1#main(temp0)->((print_int temp0))) + (fun temp2#main()->((wrap (test3 ) 1 10 100))) + (fun main()->(0)) + $ dune exec lambda_lifting_test < manytests/typed/005fix.ml + (fun fix(f x)->((f (fix f) x))) + (fun fac(self n)->(if ((n<=1)) then (1) else ((n*(self (n-1)))))) + (fun ()#main()->((print_int (fix (fac ) 6)))) + (fun main()->(0)) + $ dune exec lambda_lifting_test < manytests/typed/006partial.ml + (fun anon$1#foo(foo)->((foo+2))) + (fun anon$2#foo(foo)->((foo*10))) + (fun foo(b)->(if (b) then ((anon$1#foo )) else ((anon$2#foo )))) + (fun foo(x)->((foo true (foo false (foo true (foo false x)))))) + (fun ()#main()->((print_int (foo 11)))) + (fun main()->(0)) + $ dune exec lambda_lifting_test < manytests/typed/006partial2.ml + (fun ()#foo(a)->((print_int a))) + (fun ()#foo(b)->((print_int b))) + (fun ()#foo(c)->((print_int c))) + (fun foo(a b c)->((a+(b*c)))) + (fun foo#main()->((foo#main 1))) + (fun foo#main(foo)->((foo#main foo#main 2))) + (fun foo#main(foo)->((foo#main foo#main 3))) + (fun ()#main(foo)->((print_int foo))) + (fun main()->(0)) + $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml + (fun ()#foo(a)->((print_int a))) + (fun ()#anon$1#foo(b)->((print_int b))) + (fun anon$2#anon$1#foo(c)->((print_int c))) + (fun anon$1#foo(b)->((anon$2#anon$1#foo ))) + (fun foo(a)->((anon$1#foo ))) + (fun ()#main()->((foo 4 8 9))) + (fun main()->(0)) + $ dune exec lambda_lifting_test < manytests/typed/007order.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 26387100a..d979091f7 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -32,7 +32,7 @@ $ dune exec parser_test << EOF > (a b 2 1+3 * b d (-2) (r f)) + 3 > EOF - (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) + Error: : end_of_input $ dune exec parser_test << EOF > a b c > EOF @@ -54,7 +54,7 @@ > EOF ((a<2)&&(b=3)) $ dune exec parser_test << EOF - > (a b 2 1+3 * b d (-2) (r f)) + 3 + > ((a b 2 1 + 3 * b d (-2) (r f)) + 3) > EOF (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) $ dune exec parser_test << EOF @@ -80,25 +80,44 @@ > ;; > EOF (let x=(fack->n)) + $ dune exec parser_test << EOF + > f 1 + f 2 + > EOF + ((f->1)+(f->2)) + $ dune exec parser_test << EOF + > let rec fib n = + > if n<2 + > then n + > else (fib (n - 1) + fib (n - 2)) + > EOF + (let rec fib n=if ((n<2)) then (n) else ((fib->((n-1)+(fib->(n-2)))))) $ dune exec parser_test < manytests/typed/001fac.ml (let rec fac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) (let main=(let ()=(print_int->(fac->4)) in 0)) $ dune exec parser_test < manytests/typed/002fac.ml - (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))->(let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0))))) + (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))))) + (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) $ dune exec parser_test < manytests/typed/003fib.ml Error: : end_of_input $ dune exec parser_test < manytests/typed/004manyargs.ml - (let wrap f=if ((1=1)) then (f) else ((f->(let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0))))->(let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j))->(let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0))))))) + (let wrap f=if ((1=1)) then (f) else (f)) + (let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0)))) + (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) + (let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0)))) $ dune exec parser_test < manytests/typed/005fix.ml - (let rec fix f x=(f->(fix->f)->x->(let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1)))))->(let main=(let ()=(print_int->(fix->fac->6)) in 0)))) + (let rec fix f x=(f->(fix->f)->x)) + (let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1))))) + (let main=(let ()=(print_int->(fix->fac->6)) in 0)) $ dune exec parser_test < manytests/typed/006partial.ml (let foo b=if (b) then ((fun foo->(foo+2))) else ((fun foo->(foo*10)))) - (let foo x=(foo->true->(foo->false->(foo->true->(foo->false->x)))->(let main=(let ()=(print_int->(foo->11)) in 0)))) + (let foo x=(foo->true->(foo->false->(foo->true->(foo->false->x))))) + (let main=(let ()=(print_int->(foo->11)) in 0)) $ dune exec parser_test < manytests/typed/006partial2.ml (let foo a b c=(let ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(print_int->c) in (a+(b*c)))))) (let main=(let foo=(foo->1) in (let foo=(foo->2) in (let foo=(foo->3) in (let ()=(print_int->foo) in 0))))) $ dune exec parser_test < manytests/typed/006partial3.ml - (let foo a=(let ()=(print_int->a) in (fun b->(let ()=(print_int->b) in (fun c->(print_int->c->(let main=(let ()=(foo->4->8->9) in 0)))))))) + (let foo a=(let ()=(print_int->a) in (fun b->(let ()=(print_int->b) in (fun c->(print_int->c)))))) + (let main=(let ()=(foo->4->8->9) in 0)) $ dune exec parser_test < manytests/typed/007order.ml Error: : end_of_input $ dune exec parser_test < manytests/typed/008ascription.ml @@ -107,3 +126,4 @@ Error: : end_of_input $ dune exec parser_test < manytests/typed/016lists.ml Error: : end_of_input + diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index 207b1443d..5b5a62243 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -271,3 +271,626 @@ ld s0,40(sp) addi sp,sp,64 ret + $ dune exec riscv64_instr_test < manytests/typed/001fac.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fac: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + li t0,1 + ble t0,a0,.tag_anf_op_1 + li t1,1 + mv a0,t1 + j .tag_anf_op_1_t + .tag_anf_op_1: + ld a0,-88(s0) + li t2,1 + sub t3,a0,t2 + sd t3,-24(s0) + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t3,-88(s0) + mul t2,t3,a0 + sd a0,-32(s0) + mv a0,t2 + .tag_anf_op_1_t: + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + ()_main: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a3,4 + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + main: + addi sp,sp,-16 + sd ra,8(sp) + sd s0,0(sp) + addi s0,sp,16 + li t0,0 + mv a0,t0 + ld ra,8(sp) + ld s0,0(sp) + addi sp,sp,16 + ret + $ dune exec riscv64_instr_test < manytests/typed/002fac.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1_fac_cps: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) + mul t0,a2,a0 + sd t0,-24(s0) + ld a0,-72(s0) + ld a3,-24(s0) + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + fac_cps: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a1,-152(s0) + sd a0,-144(s0) + li t0,1 + beq a0,t0,.tag_anf_op_3 + ld a0,-152(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + j .tag_anf_op_3_t + .tag_anf_op_3: + ld t0,-144(s0) + li a1,1 + sub t1,t0,a1 + sd a0,-24(s0) + sd t1,-32(s0) + lui a0,%hi(anon_1_fac_cps) + addi a0,a0,%lo(anon_1_fac_cps) + ld a4,-152(s0) + ld a3,-144(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-40(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-40(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + .tag_anf_op_3_t: + sd a0,-48(s0) + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + anon_1_()_main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + addi s0,sp,32 + sd a0,-24(s0) + mv a0,a0 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 + ret + ()_main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + lui a0,%hi(anon_1_()_main) + addi a0,a0,%lo(anon_1_()_main) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-24(s0) + li a3,4 + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + main: + addi sp,sp,-16 + sd ra,8(sp) + sd s0,0(sp) + addi s0,sp,16 + li t0,0 + mv a0,t0 + ld ra,8(sp) + ld s0,0(sp) + addi sp,sp,16 + ret + $ dune exec riscv64_instr_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml + a#test3 not found + $ dune exec riscv64_instr_test < manytests/typed/005fix.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fix: + addi sp,sp,-96 + sd ra,88(sp) + sd s0,80(sp) + addi s0,sp,96 + sd a1,-96(s0) + sd a0,-88(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + ld a3,-88(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-24(s0) + ld a0,-88(s0) + ld a4,-96(s0) + ld a3,-24(s0) + li a2,2 + li a1,0 + call part_app + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 + ret + fac: + addi sp,sp,-96 + sd ra,88(sp) + sd s0,80(sp) + addi s0,sp,96 + sd a1,-96(s0) + sd a0,-88(s0) + li t0,1 + ble t0,a1,.tag_anf_op_3 + li t1,1 + mv a0,t1 + j .tag_anf_op_3_t + .tag_anf_op_3: + li a0,1 + sub t2,a1,a0 + sd t2,-24(s0) + ld a0,-88(s0) + ld a3,-24(s0) + li a2,1 + li a1,0 + call part_app + ld t2,-96(s0) + mul t1,t2,a0 + sd a0,-32(s0) + mv a0,t1 + .tag_anf_op_3_t: + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 + ret + ()_main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a2,0 + li a1,2 + call part_app + sd a0,-24(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + li a4,6 + ld a3,-24(s0) + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + main: + addi sp,sp,-16 + sd ra,8(sp) + sd s0,0(sp) + addi s0,sp,16 + li t0,0 + mv a0,t0 + ld ra,8(sp) + ld s0,0(sp) + addi sp,sp,16 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1_foo: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,2 + add t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + anon_2_foo: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,10 + mul t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + foo: + addi sp,sp,-96 + sd ra,88(sp) + sd s0,80(sp) + addi s0,sp,96 + sd a0,-96(s0) + beqz a0,.tag_if_bnch + lui a0,%hi(anon_1_foo) + addi a0,a0,%lo(anon_1_foo) + li a2,0 + li a1,1 + call part_app + j .tag_if_bnch_t + .tag_if_bnch: + sd a0,-24(s0) + lui a0,%hi(anon_2_foo) + addi a0,a0,%lo(anon_2_foo) + li a2,0 + li a1,1 + call part_app + .tag_if_bnch_t: + sd a0,-32(s0) + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 + ret + foo: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-152(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-24(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + sd a0,-32(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-32(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-40(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-40(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + ()_main: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,11 + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + main: + addi sp,sp,-16 + sd ra,8(sp) + sd s0,0(sp) + addi s0,sp,16 + li t0,0 + mv a0,t0 + ld ra,8(sp) + ld s0,0(sp) + addi sp,sp,16 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml + foo#main not found + $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + ()_foo: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-56(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + ()_anon_1_foo: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-56(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + anon_2_anon_1_foo: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-56(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + anon_1_foo: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) + lui a0,%hi(anon_2_anon_1_foo) + addi a0,a0,%lo(anon_2_anon_1_foo) + li a2,0 + li a1,1 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + foo: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) + lui a0,%hi(anon_1_foo) + addi a0,a0,%lo(anon_1_foo) + li a2,0 + li a1,1 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + ()_main: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a5,9 + li a4,8 + li a3,4 + li a2,3 + li a1,1 + call part_app + mv a0,a0 + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret + main: + addi sp,sp,-16 + sd ra,8(sp) + sd s0,0(sp) + addi s0,sp,16 + li t0,0 + mv a0,t0 + ld ra,8(sp) + ld s0,0(sp) + addi sp,sp,16 + ret + $ dune exec riscv64_instr_test < manytests/typed/007order.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/016lists.ml + : end_of_input From 8153b2d5747264d38c99346ee09f1a34301c14a9 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Wed, 19 Mar 2025 18:17:55 +0300 Subject: [PATCH 16/24] Add () and temp var --- slarnML/lib/anf/anf_conv.ml | 4 + slarnML/lib/anf/clos_conv.ml | 10 +- slarnML/lib/anf/lambda_lifting.ml | 9 +- slarnML/lib/anf/ll_ast.ml | 1 + slarnML/lib/pretty_print/pprint_ll.ml | 2 + slarnML/test/anf_conv_test.t | 271 +++++++++------ slarnML/test/clos_conv_test.t | 6 +- slarnML/test/lambda_lifting_test.t | 41 +-- slarnML/test/riscv64_instr_test.t | 470 ++++++++------------------ 9 files changed, 353 insertions(+), 461 deletions(-) diff --git a/slarnML/lib/anf/anf_conv.ml b/slarnML/lib/anf/anf_conv.ml index ee5d1420a..b874e5bf1 100644 --- a/slarnML/lib/anf/anf_conv.ml +++ b/slarnML/lib/anf/anf_conv.ml @@ -72,6 +72,10 @@ let rec anf_expr e expr_with_hole = | LApp (id, []) -> let name = get_name "anf_app" in ALet (name, AApp (AId id, []), expr_with_hole (AId name)) + | LIn (id, e1, e2) -> + anf_expr e1 (fun limm -> + let name = get_name id in + ALet (name, AApp (limm, []), anf_expr e2 expr_with_hole)) ;; (* | LApp (id, []) -> expr_with_hole (AId id) *) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 192acfc4e..4452de65c 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -134,7 +134,10 @@ let rec simplify ast lvl f res = |> update_args env (lvl + 1) |> simplify e (lvl + 1) f_id |> filter lvl - |> update_ast (fun a -> CLet (dec id (List.append new_args args), a)) + |> update_ast (fun a -> + if id = "()" + then CLet (dec id args, a) + else CLet (dec id (List.append new_args args), a)) |> update_args [ id ] lvl | LetIn (d, e1, e2) -> let id, args, env, dec = @@ -164,7 +167,10 @@ let rec simplify ast lvl f res = |> filter lvl |> update_args [ id ] lvl |> simplify e2 lvl f_id - |> update_ast (fun a2 -> CLetIn (dec id (List.append new_args args), a1, a2)) + |> update_ast (fun a2 -> + if id = "()" + then CLetIn (dec id args, a1, a2) + else CLetIn (dec id (List.append new_args args), a1, a2)) | Fun (a, e) -> (match a with | [] -> Error "Fun hasn't args" diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 49fc50973..703c553b8 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -110,9 +110,14 @@ let rec lifting cc_ast stack lvl res = |> update_env_decl (get_args d) |> update_env_fun id stack lvl |> lifting e1 (id :: stack) (lvl + 1) - |> (fun r1 -> - r1 |> get_ast >>= fun a -> r1 |> insert_let (get_fun_let (get_decl d) a)) + |> fun r1 -> + r1 + |> get_ast + >>= fun a1 -> + (if id = "()" then r1 else r1 |> insert_let (get_fun_let (get_decl d) a1)) |> lifting e2 stack lvl + |> update_ast (fun a2 -> + Result (LIn ((if id = "()" then id else get_name id stack), a1, a2))) |> filter lvl | CFun (args, e) -> res diff --git a/slarnML/lib/anf/ll_ast.ml b/slarnML/lib/anf/ll_ast.ml index 8f72b9a1c..15f4d1b34 100644 --- a/slarnML/lib/anf/ll_ast.ml +++ b/slarnML/lib/anf/ll_ast.ml @@ -19,6 +19,7 @@ type l_expr = | LDiv of l_expr * l_expr | LIf of l_expr * l_expr * l_expr | LApp of string * l_expr list + | LIn of string * l_expr * l_expr [@@deriving show { with_path = false }] type gl_expr = LFun of string * string list * l_expr (* declare function *) diff --git a/slarnML/lib/pretty_print/pprint_ll.ml b/slarnML/lib/pretty_print/pprint_ll.ml index 8934dfef3..0e585900c 100644 --- a/slarnML/lib/pretty_print/pprint_ll.ml +++ b/slarnML/lib/pretty_print/pprint_ll.ml @@ -28,6 +28,8 @@ let rec pp_ll_expr expr = [ "if ("; pp_ll_expr e1; ") then ("; pp_ll_expr e2; ") else ("; pp_ll_expr e3; ")" ] | LApp (e, args) -> concat "" [ "("; e; " "; concat " " (List.map pp_ll_expr args); ")" ] + | LIn (id, e1, e2) -> + concat "" [ "let "; id; " = ("; pp_ll_expr e1; " in "; pp_ll_expr e2; ")" ] ;; let pp_gl_expr = function diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 1d832d9b3..463aa1a60 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -34,11 +34,29 @@ x ) (fun fac(n)-> - (let anf_app#9=(anon$2#fac ) + (let anf_op#9=(n<=1) in - (let anf_app#10=(fack#fac n anf_app#9) + (let anf_if#10=if (anf_op#9) + then ( + (let anf_app#11=(f 1) + in + anf_app#11) + ) else ( + (let anf_op#12=(n-1) + in + (let anf_app#13=(anon$1#fack#fac n f) + in + (let anf_app#14=(fack#fac anf_op#12 anf_app#13) + in + anf_app#14)))) + in + (let fack#fac#15=(anf_if#10 ) in - anf_app#10)) + (let anf_app#16=(anon$2#fac ) + in + (let anf_app#17=(fack#fac n anf_app#16) + in + anf_app#17))))) ) $ dune exec anf_conv_test << EOF > let fac n = @@ -64,9 +82,25 @@ anf_if#2)) ) (fun fac(n)-> - (let anf_app#6=(fack#fac n) + (let anf_op#6=(n<1) in - anf_app#6) + (let anf_if#7=if (anf_op#6) + then ( + n + ) else ( + (let anf_op#8=(n-1) + in + (let anf_app#9=(fack#fac anf_op#8) + in + (let anf_op#10=(n*anf_app#9) + in + anf_op#10)))) + in + (let fack#fac#11=(anf_if#7 ) + in + (let anf_app#12=(fack#fac n) + in + anf_app#12)))) ) $ dune exec anf_conv_test << EOF > let f a = @@ -86,14 +120,34 @@ anf_op#3))) ) (fun g#f(a c d)-> - (let anf_app#4=(h#g#f a c d 4) + (let anf_op#4=(d*e) in - anf_app#4) + (let anf_op#5=(c+anf_op#4) + in + (let anf_op#6=(a*anf_op#5) + in + (let h#g#f#7=(anf_op#6 ) + in + (let anf_app#8=(h#g#f a c d 4) + in + anf_app#8))))) ) (fun f(a)-> - (let anf_app#5=(g#f a 2 3) + (let anf_op#9=(d*e) in - anf_app#5) + (let anf_op#10=(c+anf_op#9) + in + (let anf_op#11=(a*anf_op#10) + in + (let h#g#f#12=(anf_op#11 ) + in + (let anf_app#13=(h#g#f a c d 4) + in + (let g#f#14=(anf_app#13 ) + in + (let anf_app#15=(g#f a 2 3) + in + anf_app#15))))))) ) $ dune exec anf_conv_test < manytests/typed/001fac.ml (fun fac(n)-> @@ -113,15 +167,14 @@ in anf_if#2)) ) - (fun ()#main()-> + (fun main()-> (let anf_app#6=(fac 4) in (let anf_app#7=(print_int anf_app#6) in - anf_app#7)) - ) - (fun main()-> - 0 + (let ()#8=(anf_app#7 ) + in + 0))) ) $ dune exec anf_conv_test < manytests/typed/002fac.ml (fun anon$1#fac_cps(n k p)-> @@ -153,17 +206,16 @@ (fun anon$1#()#main(print_int)-> print_int ) - (fun ()#main()-> + (fun main()-> (let anf_app#9=(anon$1#()#main ) in (let anf_app#10=(fac_cps 4 anf_app#9) in (let anf_app#11=(print_int anf_app#10) in - anf_app#11))) - ) - (fun main()-> - 0 + (let ()#12=(anf_app#11 ) + in + 0)))) ) $ dune exec anf_conv_test < manytests/typed/003fib.ml : end_of_input @@ -195,50 +247,78 @@ anf_app#5) ) (fun test3(a b c)-> - 0 + (let anf_app#6=(print_int a#test3) + in + (let a#test3#7=(anf_app#6 ) + in + (let anf_app#8=(print_int b#test3) + in + (let b#test3#9=(anf_app#8 ) + in + (let anf_app#10=(print_int c#test3) + in + (let c#test3#11=(anf_app#10 ) + in + 0)))))) ) (fun test10(a b c d e f g h i j)-> - (let anf_op#6=(a+b) + (let anf_op#12=(a+b) in - (let anf_op#7=(anf_op#6+c) + (let anf_op#13=(anf_op#12+c) in - (let anf_op#8=(anf_op#7+d) + (let anf_op#14=(anf_op#13+d) in - (let anf_op#9=(anf_op#8+e) + (let anf_op#15=(anf_op#14+e) in - (let anf_op#10=(anf_op#9+f) + (let anf_op#16=(anf_op#15+f) in - (let anf_op#11=(anf_op#10+g) + (let anf_op#17=(anf_op#16+g) in - (let anf_op#12=(anf_op#11+h) + (let anf_op#18=(anf_op#17+h) in - (let anf_op#13=(anf_op#12+i) + (let anf_op#19=(anf_op#18+i) in - (let anf_op#14=(anf_op#13+j) + (let anf_op#20=(anf_op#19+j) in - anf_op#14))))))))) + anf_op#20))))))))) ) (fun temp0#main()-> - (let anf_app#15=(test10 ) + (let anf_app#21=(test10 ) in - (let anf_app#16=(wrap anf_app#15 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#22=(wrap anf_app#21 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - anf_app#16)) + anf_app#22)) ) (fun temp1#main(temp0)-> - (let anf_app#17=(print_int temp0) + (let anf_app#23=(print_int temp0) in - anf_app#17) + anf_app#23) ) (fun temp2#main()-> - (let anf_app#18=(test3 ) + (let anf_app#24=(test3 ) in - (let anf_app#19=(wrap anf_app#18 1 10 100) + (let anf_app#25=(wrap anf_app#24 1 10 100) in - anf_app#19)) + anf_app#25)) ) (fun main()-> - 0 + (let anf_app#26=(test10 ) + in + (let anf_app#27=(wrap anf_app#26 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + in + (let temp0#main#28=(anf_app#27 ) + in + (let anf_app#29=(print_int temp0) + in + (let temp1#main#30=(anf_app#29 ) + in + (let anf_app#31=(test3 ) + in + (let anf_app#32=(wrap anf_app#31 1 10 100) + in + (let temp2#main#33=(anf_app#32 ) + in + 0)))))))) ) $ dune exec anf_conv_test < manytests/typed/005fix.ml (fun fix(f x)-> @@ -265,17 +345,16 @@ in anf_if#4)) ) - (fun ()#main()-> + (fun main()-> (let anf_app#8=(fac ) in (let anf_app#9=(fix anf_app#8 6) in (let anf_app#10=(print_int anf_app#9) in - anf_app#10))) - ) - (fun main()-> - 0 + (let ()#11=(anf_app#10 ) + in + 0)))) ) $ dune exec anf_conv_test < manytests/typed/006partial.ml (fun anon$1#foo(foo)-> @@ -312,95 +391,99 @@ in anf_app#9)))) ) - (fun ()#main()-> + (fun main()-> (let anf_app#10=(foo 11) in (let anf_app#11=(print_int anf_app#10) in - anf_app#11)) - ) - (fun main()-> - 0 + (let ()#12=(anf_app#11 ) + in + 0))) ) $ dune exec anf_conv_test < manytests/typed/006partial2.ml - (fun ()#foo(a)-> + (fun foo(a b c)-> (let anf_app#1=(print_int a) in - anf_app#1) - ) - (fun ()#foo(b)-> - (let anf_app#2=(print_int b) + (let ()#2=(anf_app#1 ) in - anf_app#2) - ) - (fun ()#foo(c)-> - (let anf_app#3=(print_int c) + (let anf_app#3=(print_int b) in - anf_app#3) - ) - (fun foo(a b c)-> - (let anf_op#4=(b*c) + (let ()#4=(anf_app#3 ) + in + (let anf_app#5=(print_int c) + in + (let ()#6=(anf_app#5 ) in - (let anf_op#5=(a+anf_op#4) + (let anf_op#7=(b*c) in - anf_op#5)) + (let anf_op#8=(a+anf_op#7) + in + anf_op#8)))))))) ) (fun foo#main()-> - (let anf_app#6=(foo#main 1) + (let anf_app#9=(foo#main 1) in - anf_app#6) + anf_app#9) ) (fun foo#main(foo)-> - (let anf_app#7=(foo#main foo#main 2) + (let anf_app#10=(foo#main foo#main 2) in - anf_app#7) + anf_app#10) ) (fun foo#main(foo)-> - (let anf_app#8=(foo#main foo#main 3) - in - anf_app#8) - ) - (fun ()#main(foo)-> - (let anf_app#9=(print_int foo) + (let anf_app#11=(foo#main foo#main 3) in - anf_app#9) + anf_app#11) ) (fun main()-> - 0 + (let anf_app#12=(foo#main 1) + in + (let foo#main#13=(anf_app#12 ) + in + (let anf_app#14=(foo#main foo#main 2) + in + (let foo#main#15=(anf_app#14 ) + in + (let anf_app#16=(foo#main foo#main 3) + in + (let foo#main#17=(anf_app#16 ) + in + (let anf_app#18=(print_int foo#main) + in + (let ()#19=(anf_app#18 ) + in + 0)))))))) ) $ dune exec anf_conv_test < manytests/typed/006partial3.ml - (fun ()#foo(a)-> - (let anf_app#1=(print_int a) + (fun anon$2#anon$1#foo(c)-> + (let anf_app#1=(print_int c) in anf_app#1) ) - (fun ()#anon$1#foo(b)-> + (fun anon$1#foo(b)-> (let anf_app#2=(print_int b) in - anf_app#2) - ) - (fun anon$2#anon$1#foo(c)-> - (let anf_app#3=(print_int c) + (let ()#3=(anf_app#2 ) in - anf_app#3) - ) - (fun anon$1#foo(b)-> (let anf_app#4=(anon$2#anon$1#foo ) in - anf_app#4) + anf_app#4))) ) (fun foo(a)-> - (let anf_app#5=(anon$1#foo ) + (let anf_app#5=(print_int a) in - anf_app#5) - ) - (fun ()#main()-> - (let anf_app#6=(foo 4 8 9) + (let ()#6=(anf_app#5 ) in - anf_app#6) + (let anf_app#7=(anon$1#foo ) + in + anf_app#7))) ) (fun main()-> - 0 + (let anf_app#8=(foo 4 8 9) + in + (let ()#9=(anf_app#8 ) + in + 0)) ) $ dune exec anf_conv_test < manytests/typed/007order.ml : end_of_input diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index 1aab5e813..6d9871903 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -52,10 +52,10 @@ (let foo x=((foo ) true ((foo ) false ((foo ) true ((foo ) false x))))) (let main=(let ()=((print_int ) ((foo ) 11)) in 0)) $ dune exec clos_conv_test < manytests/typed/006partial2.ml - (let foo a b c=(let () a=((print_int ) a) in (let () b=((print_int ) b) in (let () c=((print_int ) c) in (a+(b*c)))))) - (let main=(let foo=((foo ) 1) in (let foo foo=((foo foo) 2) in (let foo foo=((foo foo) 3) in (let () foo=((print_int ) foo) in 0))))) + (let foo a b c=(let ()=((print_int ) a) in (let ()=((print_int ) b) in (let ()=((print_int ) c) in (a+(b*c)))))) + (let main=(let foo=((foo ) 1) in (let foo foo=((foo foo) 2) in (let foo foo=((foo foo) 3) in (let ()=((print_int ) foo) in 0))))) $ dune exec clos_conv_test < manytests/typed/006partial3.ml - (let foo a=(let () a=((print_int ) a) in ((fun b->(let () b=((print_int ) b) in ((fun c->((print_int ) c)) ))) ))) + (let foo a=(let ()=((print_int ) a) in ((fun b->(let ()=((print_int ) b) in ((fun c->((print_int ) c)) ))) ))) (let main=(let ()=((foo ) 4 8 9) in 0)) $ dune exec clos_conv_test < manytests/typed/007order.ml : end_of_input diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 4e643e38b..8301e97be 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -7,7 +7,7 @@ (fun anon$1#fack#fac(n f x)->((x*(f n)))) (fun fack#fac(n f)->(if ((n<=1)) then ((f 1)) else ((fack#fac (n-1) (anon$1#fack#fac n f))))) (fun anon$2#fac(x)->(x)) - (fun fac(n)->((fack#fac n (anon$2#fac )))) + (fun fac(n)->(let fack#fac = (if ((n<=1)) then ((f 1)) else ((fack#fac (n-1) (anon$1#fack#fac n f))) in (fack#fac n (anon$2#fac ))))) $ dune exec lambda_lifting_test << EOF > let fac n = > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in @@ -15,7 +15,7 @@ > ;; > EOF (fun fack#fac(n)->(if ((n<1)) then (n) else ((n*(fack#fac (n-1)))))) - (fun fac(n)->((fack#fac n))) + (fun fac(n)->(let fack#fac = (if ((n<1)) then (n) else ((n*(fack#fac (n-1)))) in (fack#fac n)))) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -25,18 +25,16 @@ > (g 2 3) > EOF (fun h#g#f(a c d e)->((a*(c+(d*e))))) - (fun g#f(a c d)->((h#g#f a c d 4))) - (fun f(a)->((g#f a 2 3))) + (fun g#f(a c d)->(let h#g#f = ((a*(c+(d*e))) in (h#g#f a c d 4)))) + (fun f(a)->(let g#f = (let h#g#f = ((a*(c+(d*e))) in (h#g#f a c d 4)) in (g#f a 2 3)))) $ dune exec lambda_lifting_test < manytests/typed/001fac.ml (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) - (fun ()#main()->((print_int (fac 4)))) - (fun main()->(0)) + (fun main()->(let () = ((print_int (fac 4)) in 0))) $ dune exec lambda_lifting_test < manytests/typed/002fac.ml (fun anon$1#fac_cps(n k p)->((k (p*n)))) (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1#fac_cps n k))))) (fun anon$1#()#main(print_int)->(print_int)) - (fun ()#main()->((print_int (fac_cps 4 (anon$1#()#main ))))) - (fun main()->(0)) + (fun main()->(let () = ((print_int (fac_cps 4 (anon$1#()#main ))) in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml : end_of_input $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml @@ -44,42 +42,33 @@ (fun a#test3(a)->((print_int a#test3))) (fun b#test3(b)->((print_int b#test3))) (fun c#test3(c)->((print_int c#test3))) - (fun test3(a b c)->(0)) + (fun test3(a b c)->(let a#test3 = ((print_int a#test3) in let b#test3 = ((print_int b#test3) in let c#test3 = ((print_int c#test3) in 0))))) (fun test10(a b c d e f g h i j)->((((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j))) (fun temp0#main()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) (fun temp1#main(temp0)->((print_int temp0))) (fun temp2#main()->((wrap (test3 ) 1 10 100))) - (fun main()->(0)) + (fun main()->(let temp0#main = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1#main = ((print_int temp0) in let temp2#main = ((wrap (test3 ) 1 10 100) in 0))))) $ dune exec lambda_lifting_test < manytests/typed/005fix.ml (fun fix(f x)->((f (fix f) x))) (fun fac(self n)->(if ((n<=1)) then (1) else ((n*(self (n-1)))))) - (fun ()#main()->((print_int (fix (fac ) 6)))) - (fun main()->(0)) + (fun main()->(let () = ((print_int (fix (fac ) 6)) in 0))) $ dune exec lambda_lifting_test < manytests/typed/006partial.ml (fun anon$1#foo(foo)->((foo+2))) (fun anon$2#foo(foo)->((foo*10))) (fun foo(b)->(if (b) then ((anon$1#foo )) else ((anon$2#foo )))) (fun foo(x)->((foo true (foo false (foo true (foo false x)))))) - (fun ()#main()->((print_int (foo 11)))) - (fun main()->(0)) + (fun main()->(let () = ((print_int (foo 11)) in 0))) $ dune exec lambda_lifting_test < manytests/typed/006partial2.ml - (fun ()#foo(a)->((print_int a))) - (fun ()#foo(b)->((print_int b))) - (fun ()#foo(c)->((print_int c))) - (fun foo(a b c)->((a+(b*c)))) + (fun foo(a b c)->(let () = ((print_int a) in let () = ((print_int b) in let () = ((print_int c) in (a+(b*c))))))) (fun foo#main()->((foo#main 1))) (fun foo#main(foo)->((foo#main foo#main 2))) (fun foo#main(foo)->((foo#main foo#main 3))) - (fun ()#main(foo)->((print_int foo))) - (fun main()->(0)) + (fun main()->(let foo#main = ((foo#main 1) in let foo#main = ((foo#main foo#main 2) in let foo#main = ((foo#main foo#main 3) in let () = ((print_int foo#main) in 0)))))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - (fun ()#foo(a)->((print_int a))) - (fun ()#anon$1#foo(b)->((print_int b))) (fun anon$2#anon$1#foo(c)->((print_int c))) - (fun anon$1#foo(b)->((anon$2#anon$1#foo ))) - (fun foo(a)->((anon$1#foo ))) - (fun ()#main()->((foo 4 8 9))) - (fun main()->(0)) + (fun anon$1#foo(b)->(let () = ((print_int b) in (anon$2#anon$1#foo )))) + (fun foo(a)->(let () = ((print_int a) in (anon$1#foo )))) + (fun main()->(let () = ((foo 4 8 9) in 0))) $ dune exec lambda_lifting_test < manytests/typed/007order.ml : end_of_input $ dune exec lambda_lifting_test < manytests/typed/008ascription.ml diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index 5b5a62243..6643706fe 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -4,121 +4,7 @@ > (fack n (fun x -> x)) > ;; > EOF - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_1_fack_fac: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 - sd a2,-80(s0) - sd a1,-72(s0) - sd a0,-64(s0) - ld a0,-72(s0) - ld a3,-64(s0) - li a2,1 - li a1,0 - call part_app - ld a1,-80(s0) - mul a2,a1,a0 - mv a0,a2 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - fack_fac: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a1,-152(s0) - sd a0,-144(s0) - li t0,1 - ble t0,a0,.tag_anf_op_3 - ld a0,-152(s0) - li a3,1 - li a2,1 - li a1,0 - call part_app - j .tag_anf_op_3_t - .tag_anf_op_3: - ld t0,-144(s0) - li a1,1 - sub t1,t0,a1 - sd a0,-24(s0) - sd t1,-32(s0) - lui a0,%hi(anon_1_fack_fac) - addi a0,a0,%lo(anon_1_fack_fac) - ld a4,-152(s0) - ld a3,-144(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-40(s0) - lui a0,%hi(fack_fac) - addi a0,a0,%lo(fack_fac) - ld a4,-40(s0) - ld a3,-32(s0) - li a2,2 - li a1,2 - call part_app - .tag_anf_op_3_t: - sd a0,-48(s0) - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - anon_2_fac: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - addi s0,sp,32 - sd a0,-24(s0) - mv a0,a0 - ld ra,16(sp) - ld s0,8(sp) - addi sp,sp,32 - ret - fac: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(anon_2_fac) - addi a0,a0,%lo(anon_2_fac) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(fack_fac) - addi a0,a0,%lo(fack_fac) - ld a4,-24(s0) - ld a3,-88(s0) - li a2,2 - li a1,2 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret + f not found $ dune exec riscv64_instr_test << EOF > let fac n = > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in @@ -172,21 +58,46 @@ addi sp,sp,96 ret fac: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + li t0,1 + blt t0,a0,.tag_anf_op_6 + j .tag_anf_op_6_t + .tag_anf_op_6: + li t1,1 + sub t2,a0,t1 + sd t2,-24(s0) + lui a0,%hi(fack_fac) + addi a0,a0,%lo(fack_fac) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t2,-152(s0) + mul t1,t2,a0 + sd a0,-32(s0) + mv a0,t1 + .tag_anf_op_6_t: + sd t1,-40(s0) + sd a0,-48(s0) + ld a0,-48(s0) + li a2,0 + li a1,0 + call part_app sd a0,-56(s0) lui a0,%hi(fack_fac) addi a0,a0,%lo(fack_fac) - ld a3,-56(s0) + ld a3,-152(s0) li a2,1 li a1,1 call part_app mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret $ dune exec riscv64_instr_test << EOF > let f a = @@ -196,81 +107,7 @@ > in > (g 2 3) > EOF - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - h_g_f: - addi sp,sp,-80 - sd ra,64(sp) - sd s0,56(sp) - addi s0,sp,80 - sd a3,-72(s0) - sd a2,-64(s0) - sd a1,-56(s0) - sd a0,-48(s0) - mul t0,a2,a3 - add t1,a1,t0 - mul t2,a0,t1 - mv a0,t2 - ld ra,64(sp) - ld s0,56(sp) - addi sp,sp,80 - ret - g_f: - addi sp,sp,-80 - sd ra,64(sp) - sd s0,56(sp) - addi s0,sp,80 - sd a2,-72(s0) - sd a1,-64(s0) - sd a0,-56(s0) - lui a0,%hi(h_g_f) - addi a0,a0,%lo(h_g_f) - li a6,4 - ld a5,-72(s0) - ld a4,-64(s0) - ld a3,-56(s0) - li a2,4 - li a1,4 - call part_app - mv a0,a0 - ld ra,64(sp) - ld s0,56(sp) - addi sp,sp,80 - ret - f: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 - sd a0,-56(s0) - lui a0,%hi(g_f) - addi a0,a0,%lo(g_f) - li a5,3 - li a4,2 - ld a3,-56(s0) - li a2,3 - li a1,3 - call part_app - mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 - ret + e not found $ dune exec riscv64_instr_test < manytests/typed/001fac.ml .attribute unaligned_access, 0 .attribute stack_align, 16 @@ -321,11 +158,11 @@ ld s0,72(sp) addi sp,sp,96 ret - ()_main: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 + main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 lui a0,%hi(fac) addi a0,a0,%lo(fac) li a3,4 @@ -339,21 +176,16 @@ li a2,1 li a1,1 call part_app - mv a0,a0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - main: - addi sp,sp,-16 - sd ra,8(sp) - sd s0,0(sp) - addi s0,sp,16 + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app li t0,0 mv a0,t0 - ld ra,8(sp) - ld s0,0(sp) - addi sp,sp,16 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 ret $ dune exec riscv64_instr_test < manytests/typed/002fac.ml .attribute unaligned_access, 0 @@ -447,11 +279,11 @@ ld s0,8(sp) addi sp,sp,32 ret - ()_main: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 + main: + addi sp,sp,-144 + sd ra,136(sp) + sd s0,128(sp) + addi s0,sp,144 lui a0,%hi(anon_1_()_main) addi a0,a0,%lo(anon_1_()_main) li a2,0 @@ -472,21 +304,16 @@ li a2,1 li a1,1 call part_app - mv a0,a0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 - ret - main: - addi sp,sp,-16 - sd ra,8(sp) - sd s0,0(sp) - addi s0,sp,16 + sd a0,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app li t0,0 mv a0,t0 - ld ra,8(sp) - ld s0,0(sp) - addi sp,sp,16 + ld ra,136(sp) + ld s0,128(sp) + addi sp,sp,144 ret $ dune exec riscv64_instr_test < manytests/typed/003fib.ml : end_of_input @@ -566,11 +393,11 @@ ld s0,80(sp) addi sp,sp,96 ret - ()_main: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 + main: + addi sp,sp,-144 + sd ra,136(sp) + sd s0,128(sp) + addi s0,sp,144 lui a0,%hi(fac) addi a0,a0,%lo(fac) li a2,0 @@ -591,21 +418,16 @@ li a2,1 li a1,1 call part_app - mv a0,a0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 - ret - main: - addi sp,sp,-16 - sd ra,8(sp) - sd s0,0(sp) - addi s0,sp,16 + sd a0,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app li t0,0 mv a0,t0 - ld ra,8(sp) - ld s0,0(sp) - addi sp,sp,16 + ld ra,136(sp) + ld s0,128(sp) + addi sp,sp,144 ret $ dune exec riscv64_instr_test < manytests/typed/006partial.ml .attribute unaligned_access, 0 @@ -720,11 +542,11 @@ ld s0,136(sp) addi sp,sp,160 ret - ()_main: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 + main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 lui a0,%hi(foo) addi a0,a0,%lo(foo) li a3,11 @@ -738,21 +560,16 @@ li a2,1 li a1,1 call part_app - mv a0,a0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - main: - addi sp,sp,-16 - sd ra,8(sp) - sd s0,0(sp) - addi s0,sp,16 + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app li t0,0 mv a0,t0 - ld ra,8(sp) - ld s0,0(sp) - addi sp,sp,16 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 ret $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml foo#main not found @@ -774,7 +591,7 @@ addi sp,sp,24 li a7,93 ecall - ()_foo: + anon_2_anon_1_foo: addi sp,sp,-64 sd ra,48(sp) sd s0,40(sp) @@ -791,77 +608,67 @@ ld s0,40(sp) addi sp,sp,64 ret - ()_anon_1_foo: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 - sd a0,-56(s0) + anon_1_foo: + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 + sd a0,-120(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-56(s0) + ld a3,-120(s0) li a2,1 li a1,1 call part_app - mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 - ret - anon_2_anon_1_foo: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 - sd a0,-56(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-56(s0) - li a2,1 - li a1,1 + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 call part_app - mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 - ret - anon_1_foo: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 - sd a0,-56(s0) + sd a0,-32(s0) lui a0,%hi(anon_2_anon_1_foo) addi a0,a0,%lo(anon_2_anon_1_foo) li a2,0 li a1,1 call part_app mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 ret foo: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 - sd a0,-56(s0) + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 + sd a0,-120(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-120(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) lui a0,%hi(anon_1_foo) addi a0,a0,%lo(anon_1_foo) li a2,0 li a1,1 call part_app mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 ret - ()_main: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 + main: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 lui a0,%hi(foo) addi a0,a0,%lo(foo) li a5,9 @@ -870,21 +677,16 @@ li a2,3 li a1,1 call part_app - mv a0,a0 - ld ra,40(sp) - ld s0,32(sp) - addi sp,sp,48 - ret - main: - addi sp,sp,-16 - sd ra,8(sp) - sd s0,0(sp) - addi s0,sp,16 + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app li t0,0 mv a0,t0 - ld ra,8(sp) - ld s0,0(sp) - addi sp,sp,16 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 ret $ dune exec riscv64_instr_test < manytests/typed/007order.ml : end_of_input From b3845b6766083f4d0ad304a66a351c6946e2388a Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Wed, 19 Mar 2025 19:06:10 +0300 Subject: [PATCH 17/24] Fix naming in ll --- slarnML/lib/anf/anf_conv.ml | 2 +- slarnML/lib/anf/lambda_lifting.ml | 31 +- slarnML/lib/dune | 2 +- slarnML/test/anf_conv_test.t | 500 +++++++---- slarnML/test/lambda_lifting_test.t | 74 +- slarnML/test/riscv64_instr_test.t | 1267 ++++++++++++++++++++++------ 6 files changed, 1388 insertions(+), 488 deletions(-) diff --git a/slarnML/lib/anf/anf_conv.ml b/slarnML/lib/anf/anf_conv.ml index b874e5bf1..0f8146e90 100644 --- a/slarnML/lib/anf/anf_conv.ml +++ b/slarnML/lib/anf/anf_conv.ml @@ -74,7 +74,7 @@ let rec anf_expr e expr_with_hole = ALet (name, AApp (AId id, []), expr_with_hole (AId name)) | LIn (id, e1, e2) -> anf_expr e1 (fun limm -> - let name = get_name id in + let name = "anf_" ^ get_name id in ALet (name, AApp (limm, []), anf_expr e2 expr_with_hole)) ;; diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 703c553b8..479aed538 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -12,7 +12,8 @@ let get_anon_name = map (fun (_, _, _, num) -> Result (String.concat "$" [ "anon"; string_of_int num ])) ;; -let get_name id stack = String.concat "#" (id :: stack) +let get_name id _ = id +(* String.concat "#" (id :: stack) *) let find_name id = map (fun (_, _, env, _) -> @@ -67,6 +68,15 @@ let rec lifting cc_ast stack lvl res = let update_env_decl args res = List.fold_left (fun r a -> r |> update_env_arg a lvl) res args in + let init_func d e1 res = + let id = get_id d in + let f1, f2 = + match d with + | Ast.Decl _ -> (fun x -> x), update_env_decl (get_args d) + | Ast.DeclRec _ -> update_env_decl (get_args d), fun x -> x + in + res |> f1 |> update_env_fun id stack lvl |> lifting e1 (id :: stack) (lvl + 1) |> f2 + in match cc_ast with | CId id -> res |> find_name id >>= fun ast -> update_ast (fun _ -> Result ast) res | CConst c -> update_ast (fun _ -> Result (LConst c)) res @@ -97,19 +107,15 @@ let rec lifting cc_ast stack lvl res = >>= fun a2 -> r2 |> lifting e3 stack lvl |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) | CLet (d, e) -> - let id = get_id d in + (* let id = get_id d in *) res - |> update_env_decl (get_args d) - |> update_env_fun id stack lvl - |> lifting e (id :: stack) (lvl + 1) + |> init_func d e |> fun r1 -> r1 |> get_ast >>= fun a -> r1 |> insert_let (get_fun_let (get_decl d) a) |> filter lvl | CLetIn (d, e1, e2) -> let id = get_id d in res - |> update_env_decl (get_args d) - |> update_env_fun id stack lvl - |> lifting e1 (id :: stack) (lvl + 1) + |> init_func d e1 |> fun r1 -> r1 |> get_ast @@ -146,7 +152,14 @@ let rec lifting cc_ast stack lvl res = (res >>= fun r -> Result (r, [])) args >>= fun (r, args) -> - let args = List.rev args in + let args = + List.map + (fun a -> + match a with + | LId id -> LApp (id, []) + | e -> e) + (List.rev args) + in Result r |> lifting e stack lvl |> update_ast (fun a -> diff --git a/slarnML/lib/dune b/slarnML/lib/dune index 8adddecf1..88eaf67ff 100644 --- a/slarnML/lib/dune +++ b/slarnML/lib/dune @@ -18,7 +18,7 @@ Lambda_lifting Anf_ast Anf_conv - Anf_test + ; Anf_test Riscv_ast Call_define Riscv diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 463aa1a60..aba4d8ebe 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -4,59 +4,71 @@ > (fack n (fun x -> x)) > ;; > EOF - (fun anon$1#fack#fac(n f x)-> - (let anf_app#1=(f n) + (fun anon$1(n f x)-> + (let anf_app#1=(n ) in - (let anf_op#2=(x*anf_app#1) + (let anf_app#2=(f anf_app#1) in - anf_op#2)) + (let anf_op#3=(x*anf_app#2) + in + anf_op#3))) ) - (fun fack#fac(n f)-> - (let anf_op#3=(n<=1) + (fun fack(n f)-> + (let anf_op#4=(n<=1) in - (let anf_if#4=if (anf_op#3) + (let anf_if#5=if (anf_op#4) then ( - (let anf_app#5=(f 1) + (let anf_app#6=(f 1) in - anf_app#5) + anf_app#6) ) else ( - (let anf_op#6=(n-1) + (let anf_op#7=(n-1) + in + (let anf_app#8=(n ) in - (let anf_app#7=(anon$1#fack#fac n f) + (let anf_app#9=(f ) in - (let anf_app#8=(fack#fac anf_op#6 anf_app#7) + (let anf_app#10=(anon$1 anf_app#8 anf_app#9) in - anf_app#8)))) + (let anf_app#11=(fack anf_op#7 anf_app#10) + in + anf_app#11)))))) in - anf_if#4)) + anf_if#5)) ) - (fun anon$2#fac(x)-> + (fun anon$2(x)-> x ) (fun fac(n)-> - (let anf_op#9=(n<=1) + (let anf_op#12=(n<=1) in - (let anf_if#10=if (anf_op#9) + (let anf_if#13=if (anf_op#12) then ( - (let anf_app#11=(f 1) + (let anf_app#14=(f 1) in - anf_app#11) + anf_app#14) ) else ( - (let anf_op#12=(n-1) + (let anf_op#15=(n-1) + in + (let anf_app#16=(n ) in - (let anf_app#13=(anon$1#fack#fac n f) + (let anf_app#17=(f ) in - (let anf_app#14=(fack#fac anf_op#12 anf_app#13) + (let anf_app#18=(anon$1 anf_app#16 anf_app#17) in - anf_app#14)))) + (let anf_app#19=(fack anf_op#15 anf_app#18) + in + anf_app#19)))))) + in + (let anf_fack#20=(anf_if#13 ) in - (let fack#fac#15=(anf_if#10 ) + (let anf_app#21=(n ) in - (let anf_app#16=(anon$2#fac ) + (let anf_app#22=(anon$2 ) in - (let anf_app#17=(fack#fac n anf_app#16) + (let anf_app#23=(fack anf_app#21 anf_app#22) in - anf_app#17))))) + anf_app#23)))))) ) $ dune exec anf_conv_test << EOF > let fac n = @@ -64,7 +76,7 @@ > (fack n) > ;; > EOF - (fun fack#fac(n)-> + (fun fack(n)-> (let anf_op#1=(n<1) in (let anf_if#2=if (anf_op#1) @@ -73,7 +85,7 @@ ) else ( (let anf_op#3=(n-1) in - (let anf_app#4=(fack#fac anf_op#3) + (let anf_app#4=(fack anf_op#3) in (let anf_op#5=(n*anf_app#4) in @@ -90,17 +102,19 @@ ) else ( (let anf_op#8=(n-1) in - (let anf_app#9=(fack#fac anf_op#8) + (let anf_app#9=(fack anf_op#8) in (let anf_op#10=(n*anf_app#9) in anf_op#10)))) in - (let fack#fac#11=(anf_if#7 ) + (let anf_fack#11=(anf_if#7 ) in - (let anf_app#12=(fack#fac n) + (let anf_app#12=(n ) in - anf_app#12)))) + (let anf_app#13=(fack anf_app#12) + in + anf_app#13))))) ) $ dune exec anf_conv_test << EOF > let f a = @@ -110,44 +124,82 @@ > in > (g 2 3) > EOF - (fun h#g#f(a c d e)-> - (let anf_op#1=(d*e) + (fun h(a c d e)-> + (let anf_app#1=(a ) in - (let anf_op#2=(c+anf_op#1) + (let anf_app#2=(c ) in - (let anf_op#3=(a*anf_op#2) + (let anf_app#3=(d ) in - anf_op#3))) + (let anf_app#4=(e ) + in + (let anf_op#5=(anf_app#3*anf_app#4) + in + (let anf_op#6=(anf_app#2+anf_op#5) + in + (let anf_op#7=(anf_app#1*anf_op#6) + in + anf_op#7))))))) ) - (fun g#f(a c d)-> - (let anf_op#4=(d*e) + (fun g(a c d)-> + (let anf_app#8=(a ) + in + (let anf_app#9=(c ) + in + (let anf_app#10=(d ) + in + (let anf_app#11=(e ) + in + (let anf_op#12=(anf_app#10*anf_app#11) + in + (let anf_op#13=(anf_app#9+anf_op#12) in - (let anf_op#5=(c+anf_op#4) + (let anf_op#14=(anf_app#8*anf_op#13) in - (let anf_op#6=(a*anf_op#5) + (let anf_h#15=(anf_op#14 ) in - (let h#g#f#7=(anf_op#6 ) + (let anf_app#16=(a ) in - (let anf_app#8=(h#g#f a c d 4) + (let anf_app#17=(c ) in - anf_app#8))))) + (let anf_app#18=(d ) + in + (let anf_app#19=(h anf_app#16 anf_app#17 anf_app#18 4) + in + anf_app#19)))))))))))) ) (fun f(a)-> - (let anf_op#9=(d*e) + (let anf_app#20=(a ) + in + (let anf_app#21=(c ) + in + (let anf_app#22=(d ) + in + (let anf_app#23=(e ) + in + (let anf_op#24=(anf_app#22*anf_app#23) in - (let anf_op#10=(c+anf_op#9) + (let anf_op#25=(anf_app#21+anf_op#24) in - (let anf_op#11=(a*anf_op#10) + (let anf_op#26=(anf_app#20*anf_op#25) in - (let h#g#f#12=(anf_op#11 ) + (let anf_h#27=(anf_op#26 ) in - (let anf_app#13=(h#g#f a c d 4) + (let anf_app#28=(a ) in - (let g#f#14=(anf_app#13 ) + (let anf_app#29=(c ) in - (let anf_app#15=(g#f a 2 3) + (let anf_app#30=(d ) in - anf_app#15))))))) + (let anf_app#31=(h anf_app#28 anf_app#29 anf_app#30 4) + in + (let anf_g#32=(anf_app#31 ) + in + (let anf_app#33=(a ) + in + (let anf_app#34=(g anf_app#33 2 3) + in + anf_app#34))))))))))))))) ) $ dune exec anf_conv_test < manytests/typed/001fac.ml (fun fac(n)-> @@ -172,12 +224,12 @@ in (let anf_app#7=(print_int anf_app#6) in - (let ()#8=(anf_app#7 ) + (let anf_()#8=(anf_app#7 ) in 0))) ) $ dune exec anf_conv_test < manytests/typed/002fac.ml - (fun anon$1#fac_cps(n k p)-> + (fun anon$1(n k p)-> (let anf_op#1=(p*n) in (let anf_app#2=(k anf_op#1) @@ -195,25 +247,29 @@ ) else ( (let anf_op#6=(n-1) in - (let anf_app#7=(anon$1#fac_cps n k) + (let anf_app#7=(n ) + in + (let anf_app#8=(k ) in - (let anf_app#8=(fac_cps anf_op#6 anf_app#7) + (let anf_app#9=(anon$1 anf_app#7 anf_app#8) in - anf_app#8)))) + (let anf_app#10=(fac_cps anf_op#6 anf_app#9) + in + anf_app#10)))))) in anf_if#4)) ) - (fun anon$1#()#main(print_int)-> + (fun anon$1(print_int)-> print_int ) (fun main()-> - (let anf_app#9=(anon$1#()#main ) + (let anf_app#11=(anon$1 ) in - (let anf_app#10=(fac_cps 4 anf_app#9) + (let anf_app#12=(fac_cps 4 anf_app#11) in - (let anf_app#11=(print_int anf_app#10) + (let anf_app#13=(print_int anf_app#12) in - (let ()#12=(anf_app#11 ) + (let anf_()#14=(anf_app#13 ) in 0)))) ) @@ -225,263 +281,345 @@ in (let anf_if#2=if (anf_op#1) then ( - f + (let anf_app#3=(f ) + in + anf_app#3) ) else ( - f) + (let anf_app#4=(f ) + in + anf_app#4)) in anf_if#2)) ) - (fun a#test3(a)-> - (let anf_app#3=(print_int a#test3) + (fun a(a)-> + (let anf_app#5=(a ) in - anf_app#3) + (let anf_app#6=(print_int anf_app#5) + in + anf_app#6)) ) - (fun b#test3(b)-> - (let anf_app#4=(print_int b#test3) + (fun b(b)-> + (let anf_app#7=(b ) + in + (let anf_app#8=(print_int anf_app#7) in - anf_app#4) + anf_app#8)) ) - (fun c#test3(c)-> - (let anf_app#5=(print_int c#test3) + (fun c(c)-> + (let anf_app#9=(c ) in - anf_app#5) + (let anf_app#10=(print_int anf_app#9) + in + anf_app#10)) ) (fun test3(a b c)-> - (let anf_app#6=(print_int a#test3) + (let anf_app#11=(a ) + in + (let anf_app#12=(print_int anf_app#11) + in + (let anf_a#13=(anf_app#12 ) + in + (let anf_app#14=(b ) in - (let a#test3#7=(anf_app#6 ) + (let anf_app#15=(print_int anf_app#14) in - (let anf_app#8=(print_int b#test3) + (let anf_b#16=(anf_app#15 ) in - (let b#test3#9=(anf_app#8 ) + (let anf_app#17=(c ) in - (let anf_app#10=(print_int c#test3) + (let anf_app#18=(print_int anf_app#17) in - (let c#test3#11=(anf_app#10 ) + (let anf_c#19=(anf_app#18 ) in - 0)))))) + 0))))))))) ) (fun test10(a b c d e f g h i j)-> - (let anf_op#12=(a+b) + (let anf_app#20=(a ) in - (let anf_op#13=(anf_op#12+c) + (let anf_app#21=(b ) in - (let anf_op#14=(anf_op#13+d) + (let anf_op#22=(anf_app#20+anf_app#21) in - (let anf_op#15=(anf_op#14+e) + (let anf_app#23=(c ) in - (let anf_op#16=(anf_op#15+f) + (let anf_op#24=(anf_op#22+anf_app#23) in - (let anf_op#17=(anf_op#16+g) + (let anf_app#25=(d ) in - (let anf_op#18=(anf_op#17+h) + (let anf_op#26=(anf_op#24+anf_app#25) in - (let anf_op#19=(anf_op#18+i) + (let anf_app#27=(e ) in - (let anf_op#20=(anf_op#19+j) + (let anf_op#28=(anf_op#26+anf_app#27) in - anf_op#20))))))))) + (let anf_app#29=(f ) + in + (let anf_op#30=(anf_op#28+anf_app#29) + in + (let anf_app#31=(g ) + in + (let anf_op#32=(anf_op#30+anf_app#31) + in + (let anf_app#33=(h ) + in + (let anf_op#34=(anf_op#32+anf_app#33) + in + (let anf_app#35=(i ) + in + (let anf_op#36=(anf_op#34+anf_app#35) + in + (let anf_app#37=(j ) + in + (let anf_op#38=(anf_op#36+anf_app#37) + in + anf_op#38))))))))))))))))))) ) - (fun temp0#main()-> - (let anf_app#21=(test10 ) + (fun temp0()-> + (let anf_app#39=(test10 ) in - (let anf_app#22=(wrap anf_app#21 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#40=(wrap anf_app#39 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - anf_app#22)) + anf_app#40)) ) - (fun temp1#main(temp0)-> - (let anf_app#23=(print_int temp0) + (fun temp1(temp0)-> + (let anf_app#41=(temp0 ) + in + (let anf_app#42=(print_int anf_app#41) in - anf_app#23) + anf_app#42)) ) - (fun temp2#main()-> - (let anf_app#24=(test3 ) + (fun temp2()-> + (let anf_app#43=(test3 ) in - (let anf_app#25=(wrap anf_app#24 1 10 100) + (let anf_app#44=(wrap anf_app#43 1 10 100) in - anf_app#25)) + anf_app#44)) ) (fun main()-> - (let anf_app#26=(test10 ) + (let anf_app#45=(test10 ) in - (let anf_app#27=(wrap anf_app#26 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#46=(wrap anf_app#45 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - (let temp0#main#28=(anf_app#27 ) + (let anf_temp0#47=(anf_app#46 ) in - (let anf_app#29=(print_int temp0) + (let anf_app#48=(temp0 ) in - (let temp1#main#30=(anf_app#29 ) + (let anf_app#49=(print_int anf_app#48) in - (let anf_app#31=(test3 ) + (let anf_temp1#50=(anf_app#49 ) in - (let anf_app#32=(wrap anf_app#31 1 10 100) + (let anf_app#51=(test3 ) in - (let temp2#main#33=(anf_app#32 ) + (let anf_app#52=(wrap anf_app#51 1 10 100) in - 0)))))))) + (let anf_temp2#53=(anf_app#52 ) + in + 0))))))))) ) $ dune exec anf_conv_test < manytests/typed/005fix.ml (fun fix(f x)-> - (let anf_app#1=(fix f) + (let anf_app#1=(f ) in - (let anf_app#2=(f anf_app#1 x) + (let anf_app#2=(fix anf_app#1) in - anf_app#2)) + (let anf_app#3=(x ) + in + (let anf_app#4=(f anf_app#2 anf_app#3) + in + anf_app#4)))) ) (fun fac(self n)-> - (let anf_op#3=(n<=1) + (let anf_app#5=(n ) in - (let anf_if#4=if (anf_op#3) + (let anf_op#6=(anf_app#5<=1) + in + (let anf_if#7=if (anf_op#6) then ( 1 ) else ( - (let anf_op#5=(n-1) + (let anf_app#8=(n ) + in + (let anf_app#9=(n ) + in + (let anf_op#10=(anf_app#9-1) in - (let anf_app#6=(self anf_op#5) + (let anf_app#11=(self anf_op#10) in - (let anf_op#7=(n*anf_app#6) + (let anf_op#12=(anf_app#8*anf_app#11) in - anf_op#7)))) + anf_op#12)))))) in - anf_if#4)) + anf_if#7))) ) (fun main()-> - (let anf_app#8=(fac ) + (let anf_app#13=(fac ) in - (let anf_app#9=(fix anf_app#8 6) + (let anf_app#14=(fix anf_app#13 6) in - (let anf_app#10=(print_int anf_app#9) + (let anf_app#15=(print_int anf_app#14) in - (let ()#11=(anf_app#10 ) + (let anf_()#16=(anf_app#15 ) in 0)))) ) $ dune exec anf_conv_test < manytests/typed/006partial.ml - (fun anon$1#foo(foo)-> + (fun anon$1(foo)-> (let anf_op#1=(foo+2) in anf_op#1) ) - (fun anon$2#foo(foo)-> + (fun anon$2(foo)-> (let anf_op#2=(foo*10) in anf_op#2) ) (fun foo(b)-> - (let anf_if#3=if (b) + (let anf_app#3=(b ) + in + (let anf_if#4=if (anf_app#3) then ( - (let anf_app#4=(anon$1#foo ) + (let anf_app#5=(anon$1 ) in - anf_app#4) + anf_app#5) ) else ( - (let anf_app#5=(anon$2#foo ) + (let anf_app#6=(anon$2 ) in - anf_app#5)) + anf_app#6)) in - anf_if#3) + anf_if#4)) ) (fun foo(x)-> - (let anf_app#6=(foo false x) - in - (let anf_app#7=(foo true anf_app#6) + (let anf_app#7=(x ) in (let anf_app#8=(foo false anf_app#7) in (let anf_app#9=(foo true anf_app#8) in - anf_app#9)))) + (let anf_app#10=(foo false anf_app#9) + in + (let anf_app#11=(foo true anf_app#10) + in + anf_app#11))))) ) (fun main()-> - (let anf_app#10=(foo 11) + (let anf_app#12=(foo 11) in - (let anf_app#11=(print_int anf_app#10) + (let anf_app#13=(print_int anf_app#12) in - (let ()#12=(anf_app#11 ) + (let anf_()#14=(anf_app#13 ) in 0))) ) $ dune exec anf_conv_test < manytests/typed/006partial2.ml (fun foo(a b c)-> - (let anf_app#1=(print_int a) + (let anf_app#1=(a ) + in + (let anf_app#2=(print_int anf_app#1) + in + (let anf_()#3=(anf_app#2 ) + in + (let anf_app#4=(b ) + in + (let anf_app#5=(print_int anf_app#4) + in + (let anf_()#6=(anf_app#5 ) in - (let ()#2=(anf_app#1 ) + (let anf_app#7=(c ) in - (let anf_app#3=(print_int b) + (let anf_app#8=(print_int anf_app#7) in - (let ()#4=(anf_app#3 ) + (let anf_()#9=(anf_app#8 ) in - (let anf_app#5=(print_int c) + (let anf_app#10=(a ) in - (let ()#6=(anf_app#5 ) + (let anf_app#11=(b ) in - (let anf_op#7=(b*c) + (let anf_app#12=(c ) in - (let anf_op#8=(a+anf_op#7) + (let anf_op#13=(anf_app#11*anf_app#12) in - anf_op#8)))))))) + (let anf_op#14=(anf_app#10+anf_op#13) + in + anf_op#14)))))))))))))) ) - (fun foo#main()-> - (let anf_app#9=(foo#main 1) + (fun foo()-> + (let anf_app#15=(foo 1) in - anf_app#9) + anf_app#15) ) - (fun foo#main(foo)-> - (let anf_app#10=(foo#main foo#main 2) + (fun foo(foo)-> + (let anf_app#16=(foo ) + in + (let anf_app#17=(foo anf_app#16 2) in - anf_app#10) + anf_app#17)) ) - (fun foo#main(foo)-> - (let anf_app#11=(foo#main foo#main 3) + (fun foo(foo)-> + (let anf_app#18=(foo ) + in + (let anf_app#19=(foo anf_app#18 3) in - anf_app#11) + anf_app#19)) ) (fun main()-> - (let anf_app#12=(foo#main 1) + (let anf_app#20=(foo 1) + in + (let anf_foo#21=(anf_app#20 ) + in + (let anf_app#22=(foo ) in - (let foo#main#13=(anf_app#12 ) + (let anf_app#23=(foo anf_app#22 2) in - (let anf_app#14=(foo#main foo#main 2) + (let anf_foo#24=(anf_app#23 ) in - (let foo#main#15=(anf_app#14 ) + (let anf_app#25=(foo ) in - (let anf_app#16=(foo#main foo#main 3) + (let anf_app#26=(foo anf_app#25 3) in - (let foo#main#17=(anf_app#16 ) + (let anf_foo#27=(anf_app#26 ) in - (let anf_app#18=(print_int foo#main) + (let anf_app#28=(foo ) in - (let ()#19=(anf_app#18 ) + (let anf_app#29=(print_int anf_app#28) in - 0)))))))) + (let anf_()#30=(anf_app#29 ) + in + 0))))))))))) ) $ dune exec anf_conv_test < manytests/typed/006partial3.ml - (fun anon$2#anon$1#foo(c)-> - (let anf_app#1=(print_int c) + (fun anon$2(c)-> + (let anf_app#1=(c ) + in + (let anf_app#2=(print_int anf_app#1) in - anf_app#1) + anf_app#2)) ) - (fun anon$1#foo(b)-> - (let anf_app#2=(print_int b) + (fun anon$1(b)-> + (let anf_app#3=(b ) in - (let ()#3=(anf_app#2 ) + (let anf_app#4=(print_int anf_app#3) in - (let anf_app#4=(anon$2#anon$1#foo ) + (let anf_()#5=(anf_app#4 ) in - anf_app#4))) + (let anf_app#6=(anon$2 ) + in + anf_app#6)))) ) (fun foo(a)-> - (let anf_app#5=(print_int a) + (let anf_app#7=(a ) + in + (let anf_app#8=(print_int anf_app#7) in - (let ()#6=(anf_app#5 ) + (let anf_()#9=(anf_app#8 ) in - (let anf_app#7=(anon$1#foo ) + (let anf_app#10=(anon$1 ) in - anf_app#7))) + anf_app#10)))) ) (fun main()-> - (let anf_app#8=(foo 4 8 9) + (let anf_app#11=(foo 4 8 9) in - (let ()#9=(anf_app#8 ) + (let anf_()#12=(anf_app#11 ) in 0)) ) diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 8301e97be..4e6ccab4a 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -4,18 +4,18 @@ > (fack n (fun x -> x)) > ;; > EOF - (fun anon$1#fack#fac(n f x)->((x*(f n)))) - (fun fack#fac(n f)->(if ((n<=1)) then ((f 1)) else ((fack#fac (n-1) (anon$1#fack#fac n f))))) - (fun anon$2#fac(x)->(x)) - (fun fac(n)->(let fack#fac = (if ((n<=1)) then ((f 1)) else ((fack#fac (n-1) (anon$1#fack#fac n f))) in (fack#fac n (anon$2#fac ))))) + (fun anon$1(n f x)->((x*(f (n ))))) + (fun fack(n f)->(if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))))) + (fun anon$2(x)->(x)) + (fun fac(n)->(let fack = (if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))) in (fack (n ) (anon$2 ))))) $ dune exec lambda_lifting_test << EOF > let fac n = > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in > (fack n) > ;; > EOF - (fun fack#fac(n)->(if ((n<1)) then (n) else ((n*(fack#fac (n-1)))))) - (fun fac(n)->(let fack#fac = (if ((n<1)) then (n) else ((n*(fack#fac (n-1)))) in (fack#fac n)))) + (fun fack(n)->(if ((n<1)) then (n) else ((n*(fack (n-1)))))) + (fun fac(n)->(let fack = (if ((n<1)) then (n) else ((n*(fack (n-1)))) in (fack (n ))))) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -24,50 +24,50 @@ > in > (g 2 3) > EOF - (fun h#g#f(a c d e)->((a*(c+(d*e))))) - (fun g#f(a c d)->(let h#g#f = ((a*(c+(d*e))) in (h#g#f a c d 4)))) - (fun f(a)->(let g#f = (let h#g#f = ((a*(c+(d*e))) in (h#g#f a c d 4)) in (g#f a 2 3)))) + (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) + (fun g(a c d)->(let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)))) + (fun f(a)->(let g = (let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)) in (g (a ) 2 3)))) $ dune exec lambda_lifting_test < manytests/typed/001fac.ml (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) (fun main()->(let () = ((print_int (fac 4)) in 0))) $ dune exec lambda_lifting_test < manytests/typed/002fac.ml - (fun anon$1#fac_cps(n k p)->((k (p*n)))) - (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1#fac_cps n k))))) - (fun anon$1#()#main(print_int)->(print_int)) - (fun main()->(let () = ((print_int (fac_cps 4 (anon$1#()#main ))) in 0))) + (fun anon$1(n k p)->((k (p*n)))) + (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1 (n ) (k )))))) + (fun anon$1(print_int)->(print_int)) + (fun main()->(let () = ((print_int (fac_cps 4 (anon$1 ))) in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml : end_of_input $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml - (fun wrap(f)->(if ((1=1)) then (f) else (f))) - (fun a#test3(a)->((print_int a#test3))) - (fun b#test3(b)->((print_int b#test3))) - (fun c#test3(c)->((print_int c#test3))) - (fun test3(a b c)->(let a#test3 = ((print_int a#test3) in let b#test3 = ((print_int b#test3) in let c#test3 = ((print_int c#test3) in 0))))) - (fun test10(a b c d e f g h i j)->((((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j))) - (fun temp0#main()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) - (fun temp1#main(temp0)->((print_int temp0))) - (fun temp2#main()->((wrap (test3 ) 1 10 100))) - (fun main()->(let temp0#main = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1#main = ((print_int temp0) in let temp2#main = ((wrap (test3 ) 1 10 100) in 0))))) + (fun wrap(f)->(if ((1=1)) then ((f )) else ((f )))) + (fun a(a)->((print_int (a )))) + (fun b(b)->((print_int (b )))) + (fun c(c)->((print_int (c )))) + (fun test3(a b c)->(let a = ((print_int (a )) in let b = ((print_int (b )) in let c = ((print_int (c )) in 0))))) + (fun test10(a b c d e f g h i j)->(((((((((((a )+(b ))+(c ))+(d ))+(e ))+(f ))+(g ))+(h ))+(i ))+(j )))) + (fun temp0()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) + (fun temp1(temp0)->((print_int (temp0 )))) + (fun temp2()->((wrap (test3 ) 1 10 100))) + (fun main()->(let temp0 = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1 = ((print_int (temp0 )) in let temp2 = ((wrap (test3 ) 1 10 100) in 0))))) $ dune exec lambda_lifting_test < manytests/typed/005fix.ml - (fun fix(f x)->((f (fix f) x))) - (fun fac(self n)->(if ((n<=1)) then (1) else ((n*(self (n-1)))))) + (fun fix(f x)->((f (fix (f )) (x )))) + (fun fac(self n)->(if (((n )<=1)) then (1) else (((n )*(self ((n )-1)))))) (fun main()->(let () = ((print_int (fix (fac ) 6)) in 0))) $ dune exec lambda_lifting_test < manytests/typed/006partial.ml - (fun anon$1#foo(foo)->((foo+2))) - (fun anon$2#foo(foo)->((foo*10))) - (fun foo(b)->(if (b) then ((anon$1#foo )) else ((anon$2#foo )))) - (fun foo(x)->((foo true (foo false (foo true (foo false x)))))) + (fun anon$1(foo)->((foo+2))) + (fun anon$2(foo)->((foo*10))) + (fun foo(b)->(if ((b )) then ((anon$1 )) else ((anon$2 )))) + (fun foo(x)->((foo true (foo false (foo true (foo false (x ))))))) (fun main()->(let () = ((print_int (foo 11)) in 0))) $ dune exec lambda_lifting_test < manytests/typed/006partial2.ml - (fun foo(a b c)->(let () = ((print_int a) in let () = ((print_int b) in let () = ((print_int c) in (a+(b*c))))))) - (fun foo#main()->((foo#main 1))) - (fun foo#main(foo)->((foo#main foo#main 2))) - (fun foo#main(foo)->((foo#main foo#main 3))) - (fun main()->(let foo#main = ((foo#main 1) in let foo#main = ((foo#main foo#main 2) in let foo#main = ((foo#main foo#main 3) in let () = ((print_int foo#main) in 0)))))) + (fun foo(a b c)->(let () = ((print_int (a )) in let () = ((print_int (b )) in let () = ((print_int (c )) in ((a )+((b )*(c )))))))) + (fun foo()->((foo 1))) + (fun foo(foo)->((foo (foo ) 2))) + (fun foo(foo)->((foo (foo ) 3))) + (fun main()->(let foo = ((foo 1) in let foo = ((foo (foo ) 2) in let foo = ((foo (foo ) 3) in let () = ((print_int (foo )) in 0)))))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - (fun anon$2#anon$1#foo(c)->((print_int c))) - (fun anon$1#foo(b)->(let () = ((print_int b) in (anon$2#anon$1#foo )))) - (fun foo(a)->(let () = ((print_int a) in (anon$1#foo )))) + (fun anon$2(c)->((print_int (c )))) + (fun anon$1(b)->(let () = ((print_int (b )) in (anon$2 )))) + (fun foo(a)->(let () = ((print_int (a )) in (anon$1 )))) (fun main()->(let () = ((foo 4 8 9) in 0))) $ dune exec lambda_lifting_test < manytests/typed/007order.ml : end_of_input diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index 6643706fe..e34fa2e25 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -28,7 +28,7 @@ addi sp,sp,24 li a7,93 ecall - fack_fac: + fack: addi sp,sp,-96 sd ra,80(sp) sd s0,72(sp) @@ -41,8 +41,8 @@ li t1,1 sub t2,a0,t1 sd t2,-24(s0) - lui a0,%hi(fack_fac) - addi a0,a0,%lo(fack_fac) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) ld a3,-24(s0) li a2,1 li a1,1 @@ -58,11 +58,11 @@ addi sp,sp,96 ret fac: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a0,-152(s0) + addi sp,sp,-192 + sd ra,176(sp) + sd s0,168(sp) + addi s0,sp,192 + sd a0,-184(s0) li t0,1 blt t0,a0,.tag_anf_op_6 j .tag_anf_op_6_t @@ -70,13 +70,13 @@ li t1,1 sub t2,a0,t1 sd t2,-24(s0) - lui a0,%hi(fack_fac) - addi a0,a0,%lo(fack_fac) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) ld a3,-24(s0) li a2,1 li a1,1 call part_app - ld t2,-152(s0) + ld t2,-184(s0) mul t1,t2,a0 sd a0,-32(s0) mv a0,t1 @@ -88,16 +88,21 @@ li a1,0 call part_app sd a0,-56(s0) - lui a0,%hi(fack_fac) - addi a0,a0,%lo(fack_fac) - ld a3,-152(s0) + ld a0,-184(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-64(s0) li a2,1 li a1,1 call part_app mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 ret $ dune exec riscv64_instr_test << EOF > let f a = @@ -205,7 +210,7 @@ addi sp,sp,24 li a7,93 ecall - anon_1_fac_cps: + anon_1: addi sp,sp,-80 sd ra,72(sp) sd s0,64(sp) @@ -226,49 +231,59 @@ addi sp,sp,80 ret fac_cps: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a1,-152(s0) - sd a0,-144(s0) + addi sp,sp,-224 + sd ra,208(sp) + sd s0,200(sp) + addi s0,sp,224 + sd a1,-216(s0) + sd a0,-208(s0) li t0,1 beq a0,t0,.tag_anf_op_3 - ld a0,-152(s0) + ld a0,-216(s0) li a3,1 li a2,1 li a1,0 call part_app j .tag_anf_op_3_t .tag_anf_op_3: - ld t0,-144(s0) + ld t0,-208(s0) li a1,1 sub t1,t0,a1 sd a0,-24(s0) sd t1,-32(s0) - lui a0,%hi(anon_1_fac_cps) - addi a0,a0,%lo(anon_1_fac_cps) - ld a4,-152(s0) - ld a3,-144(s0) + ld a0,-208(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-216(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a4,-48(s0) + ld a3,-40(s0) li a2,2 li a1,3 call part_app - sd a0,-40(s0) + sd a0,-56(s0) lui a0,%hi(fac_cps) addi a0,a0,%lo(fac_cps) - ld a4,-40(s0) + ld a4,-56(s0) ld a3,-32(s0) li a2,2 li a1,2 call part_app .tag_anf_op_3_t: - sd a0,-48(s0) + sd a0,-64(s0) mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 + ld ra,208(sp) + ld s0,200(sp) + addi sp,sp,224 ret - anon_1_()_main: + anon_1: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) @@ -284,10 +299,10 @@ sd ra,136(sp) sd s0,128(sp) addi s0,sp,144 - lui a0,%hi(anon_1_()_main) - addi a0,a0,%lo(anon_1_()_main) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) li a2,0 - li a1,1 + li a1,3 call part_app sd a0,-24(s0) lui a0,%hi(fac_cps) @@ -318,8 +333,6 @@ $ dune exec riscv64_instr_test < manytests/typed/003fib.ml : end_of_input $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml - a#test3 not found - $ dune exec riscv64_instr_test < manytests/typed/005fix.ml .attribute unaligned_access, 0 .attribute stack_align, 16 .global _start @@ -337,244 +350,723 @@ addi sp,sp,24 li a7,93 ecall - fix: - addi sp,sp,-96 - sd ra,88(sp) - sd s0,80(sp) - addi s0,sp,96 - sd a1,-96(s0) - sd a0,-88(s0) - lui a0,%hi(fix) - addi a0,a0,%lo(fix) - ld a3,-88(s0) - li a2,1 - li a1,2 + wrap: + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + sd a0,-104(s0) + li t0,1 + li t1,1 + beq t0,t1,.tag_anf_op_1 + ld a0,-104(s0) + li a2,0 + li a1,0 call part_app + j .tag_anf_op_1_t + .tag_anf_op_1: sd a0,-24(s0) - ld a0,-88(s0) - ld a4,-96(s0) - ld a3,-24(s0) - li a2,2 + ld a0,-104(s0) + li a2,0 li a1,0 call part_app + .tag_anf_op_1_t: + sd a0,-32(s0) mv a0,a0 - ld ra,88(sp) - ld s0,80(sp) - addi sp,sp,96 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 ret - fac: + a: addi sp,sp,-96 - sd ra,88(sp) - sd s0,80(sp) + sd ra,80(sp) + sd s0,72(sp) addi s0,sp,96 - sd a1,-96(s0) sd a0,-88(s0) - li t0,1 - ble t0,a1,.tag_anf_op_3 - li t1,1 - mv a0,t1 - j .tag_anf_op_3_t - .tag_anf_op_3: - li a0,1 - sub t2,a1,a0 - sd t2,-24(s0) - ld a0,-88(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) ld a3,-24(s0) li a2,1 - li a1,0 + li a1,1 call part_app - ld t2,-96(s0) - mul t1,t2,a0 - sd a0,-32(s0) - mv a0,t1 - .tag_anf_op_3_t: mv a0,a0 - ld ra,88(sp) - ld s0,80(sp) + ld ra,80(sp) + ld s0,72(sp) addi sp,sp,96 ret - main: - addi sp,sp,-144 - sd ra,136(sp) - sd s0,128(sp) - addi s0,sp,144 - lui a0,%hi(fac) - addi a0,a0,%lo(fac) + b: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) li a2,0 - li a1,2 + li a1,1 call part_app sd a0,-24(s0) - lui a0,%hi(fix) - addi a0,a0,%lo(fix) - li a4,6 - ld a3,-24(s0) - li a2,2 - li a1,2 - call part_app - sd a0,-32(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-32(s0) + ld a3,-24(s0) li a2,1 li a1,1 call part_app - sd a0,-40(s0) - ld a0,-40(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,136(sp) - ld s0,128(sp) - addi sp,sp,144 - ret - $ dune exec riscv64_instr_test < manytests/typed/006partial.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_1_foo: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - sd a0,-32(s0) - li t0,2 - add t1,a0,t0 - mv a0,t1 - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 - ret - anon_2_foo: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - sd a0,-32(s0) - li t0,10 - mul t1,a0,t0 - mv a0,t1 - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 ret - foo: + c: addi sp,sp,-96 - sd ra,88(sp) - sd s0,80(sp) + sd ra,80(sp) + sd s0,72(sp) addi s0,sp,96 - sd a0,-96(s0) - beqz a0,.tag_if_bnch - lui a0,%hi(anon_1_foo) - addi a0,a0,%lo(anon_1_foo) + sd a0,-88(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) li a2,0 li a1,1 call part_app - j .tag_if_bnch_t - .tag_if_bnch: sd a0,-24(s0) - lui a0,%hi(anon_2_foo) - addi a0,a0,%lo(anon_2_foo) - li a2,0 + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 li a1,1 call part_app - .tag_if_bnch_t: - sd a0,-32(s0) mv a0,a0 - ld ra,88(sp) - ld s0,80(sp) + ld ra,80(sp) + ld s0,72(sp) addi sp,sp,96 ret - foo: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a0,-152(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-152(s0) - li a3,0 - li a2,2 + test3: + addi sp,sp,-336 + sd ra,320(sp) + sd s0,312(sp) + addi s0,sp,336 + sd a2,-328(s0) + sd a1,-320(s0) + sd a0,-312(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 li a1,1 call part_app sd a0,-24(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-24(s0) - li a3,1 - li a2,2 + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 li a1,1 call part_app sd a0,-32(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-32(s0) - li a3,0 - li a2,2 - li a1,1 + ld a0,-32(s0) + li a2,0 + li a1,0 call part_app sd a0,-40(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-40(s0) - li a3,1 - li a2,2 + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 li a1,1 call part_app - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - main: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,11 + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) li a2,1 li a1,1 call part_app - sd a0,-24(s0) + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + sd a0,-72(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-24(s0) + ld a3,-72(s0) li a2,1 li a1,1 call part_app - sd a0,-32(s0) - ld a0,-32(s0) + sd a0,-80(s0) + ld a0,-80(s0) li a2,0 li a1,0 call part_app - li t0,0 - mv a0,t0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 + li a1,0 + mv a0,a1 + ld ra,320(sp) + ld s0,312(sp) + addi sp,sp,336 ret - $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml - foo#main not found - $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml - .attribute unaligned_access, 0 + test10: + addi sp,sp,-480 + sd ra,464(sp) + sd s0,456(sp) + addi s0,sp,480 + sd a7,-472(s0) + sd a6,-464(s0) + sd a5,-456(s0) + sd a4,-448(s0) + sd a3,-440(s0) + sd a2,-432(s0) + sd a1,-424(s0) + sd a0,-416(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 + li a1,1 + call part_app + ld a1,-24(s0) + add a2,a1,a0 + sd a0,-32(s0) + sd a2,-40(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + ld a2,-40(s0) + add a1,a2,a0 + sd a0,-48(s0) + sd a1,-56(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-56(s0) + add a2,a1,a0 + sd a0,-64(s0) + sd a2,-72(s0) + ld a0,-448(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-72(s0) + add a1,a2,a0 + sd a0,-80(s0) + sd a1,-88(s0) + ld a0,-456(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-88(s0) + add a2,a1,a0 + sd a0,-96(s0) + sd a2,-104(s0) + ld a0,-464(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-104(s0) + add a1,a2,a0 + sd a0,-112(s0) + sd a1,-120(s0) + ld a0,-472(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-120(s0) + add a2,a1,a0 + sd a0,-128(s0) + sd a2,-136(s0) + ld a0,0(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-136(s0) + add a1,a2,a0 + sd a0,-144(s0) + sd a1,-152(s0) + ld a0,8(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-152(s0) + add a2,a1,a0 + mv a0,a2 + ld ra,464(sp) + ld s0,456(sp) + addi sp,sp,480 + ret + temp0: + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + lui a0,%hi(test10) + addi a0,a0,%lo(test10) + li a2,0 + li a1,10 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li t6,10000 + sd t6,0(sp) + li t6,100000 + sd t6,8(sp) + li t6,1000000 + sd t6,16(sp) + li t6,10000000 + sd t6,24(sp) + li t6,100000000 + sd t6,32(sp) + li t6,1000000000 + sd t6,40(sp) + li a7,1000 + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,11 + li a1,1 + call part_app + mv a0,a0 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 + ret + temp1: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(temp0) + addi a0,a0,%lo(temp0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + temp2: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a2,0 + li a1,3 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,4 + li a1,1 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + main: + addi sp,sp,-336 + sd ra,320(sp) + sd s0,312(sp) + addi s0,sp,336 + lui a0,%hi(test10) + addi a0,a0,%lo(test10) + li a2,0 + li a1,10 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li t6,10000 + sd t6,0(sp) + li t6,100000 + sd t6,8(sp) + li t6,1000000 + sd t6,16(sp) + li t6,10000000 + sd t6,24(sp) + li t6,100000000 + sd t6,32(sp) + li t6,1000000000 + sd t6,40(sp) + li a7,1000 + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,11 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(temp0) + addi a0,a0,%lo(temp0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a2,0 + li a1,3 + call part_app + sd a0,-72(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li a6,100 + li a5,10 + li a4,1 + ld a3,-72(s0) + li a2,4 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,320(sp) + ld s0,312(sp) + addi sp,sp,336 + ret + $ dune exec riscv64_instr_test < manytests/typed/005fix.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fix: + addi sp,sp,-160 + sd ra,152(sp) + sd s0,144(sp) + addi s0,sp,160 + sd a1,-160(s0) + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + ld a3,-24(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + ld a0,-160(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-152(s0) + ld a4,-40(s0) + ld a3,-32(s0) + li a2,2 + li a1,0 + call part_app + mv a0,a0 + ld ra,152(sp) + ld s0,144(sp) + addi sp,sp,160 + ret + fac: + addi sp,sp,-192 + sd ra,184(sp) + sd s0,176(sp) + addi s0,sp,192 + sd a1,-192(s0) + sd a0,-184(s0) + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + li a1,1 + ble a1,a0,.tag_anf_op_6 + li t0,1 + sd a0,-24(s0) + mv a0,t0 + j .tag_anf_op_6_t + .tag_anf_op_6: + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + li t0,1 + sub a1,a0,t0 + sd a0,-40(s0) + sd a1,-48(s0) + ld a0,-184(s0) + ld a3,-48(s0) + li a2,1 + li a1,0 + call part_app + ld a1,-32(s0) + mul t0,a1,a0 + sd a0,-56(s0) + mv a0,t0 + .tag_anf_op_6_t: + mv a0,a0 + ld ra,184(sp) + ld s0,176(sp) + addi sp,sp,192 + ret + main: + addi sp,sp,-144 + sd ra,136(sp) + sd s0,128(sp) + addi s0,sp,144 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a2,0 + li a1,2 + call part_app + sd a0,-24(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + li a4,6 + ld a3,-24(s0) + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,136(sp) + ld s0,128(sp) + addi sp,sp,144 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,2 + add t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + anon_2: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,10 + mul t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + foo: + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a0,-128(s0) + ld a0,-128(s0) + li a2,0 + li a1,0 + call part_app + beqz a0,.tag_if_bnch + sd a0,-24(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + li a2,0 + li a1,1 + call part_app + j .tag_if_bnch_t + .tag_if_bnch: + sd a0,-32(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + li a2,0 + li a1,1 + call part_app + .tag_if_bnch_t: + sd a0,-40(s0) + mv a0,a0 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 + ret + foo: + addi sp,sp,-192 + sd ra,176(sp) + sd s0,168(sp) + addi s0,sp,192 + sd a0,-184(s0) + ld a0,-184(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-24(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-32(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-32(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + sd a0,-40(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-40(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-48(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-48(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 + ret + main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,11 + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml + .attribute unaligned_access, 0 .attribute stack_align, 16 .global _start _start: @@ -591,78 +1083,335 @@ addi sp,sp,24 li a7,93 ecall - anon_2_anon_1_foo: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 + foo: + addi sp,sp,-448 + sd ra,432(sp) + sd s0,424(sp) + addi s0,sp,448 + sd a2,-440(s0) + sd a1,-432(s0) + sd a0,-424(s0) + ld a0,-424(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-432(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-72(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-56(s0) + ld a3,-72(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-88(s0) + ld a0,-424(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-96(s0) + ld a0,-432(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-104(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-104(s0) + mul a2,a1,a0 + ld t0,-96(s0) + add t1,t0,a2 + mv a0,t1 + ld ra,432(sp) + ld s0,424(sp) + addi sp,sp,448 + ret + foo: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,1 li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret + foo: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,2 + ld a3,-24(s0) + li a2,2 li a1,1 call part_app mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 ret - anon_1_foo: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - sd a0,-120(s0) + foo: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,3 + ld a3,-24(s0) + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + main: + addi sp,sp,-368 + sd ra,360(sp) + sd s0,352(sp) + addi s0,sp,368 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,1 + li a2,1 + li a1,3 + call part_app + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-40(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,2 + ld a3,-40(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-56(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-64(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,3 + ld a3,-64(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-72(s0) + ld a0,-72(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-80(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-88(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-120(s0) + ld a3,-88(s0) li a2,1 li a1,1 + call part_app + sd a0,-96(s0) + ld a0,-96(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,360(sp) + ld s0,352(sp) + addi sp,sp,368 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_2: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + ld a0,-88(s0) + li a2,0 + li a1,0 call part_app sd a0,-24(s0) - ld a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + anon_1: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + ld a0,-152(s0) li a2,0 li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 call part_app sd a0,-32(s0) - lui a0,%hi(anon_2_anon_1_foo) - addi a0,a0,%lo(anon_2_anon_1_foo) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) li a2,0 li a1,1 call part_app mv a0,a0 - ld ra,112(sp) - ld s0,104(sp) - addi sp,sp,128 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret foo: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - sd a0,-120(s0) + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-120(s0) + ld a3,-24(s0) li a2,1 li a1,1 call part_app - sd a0,-24(s0) - ld a0,-24(s0) + sd a0,-32(s0) + ld a0,-32(s0) li a2,0 li a1,0 call part_app - sd a0,-32(s0) - lui a0,%hi(anon_1_foo) - addi a0,a0,%lo(anon_1_foo) + sd a0,-40(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) li a2,0 li a1,1 call part_app mv a0,a0 - ld ra,112(sp) - ld s0,104(sp) - addi sp,sp,128 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret main: addi sp,sp,-80 From 539a48e4fdbd302a47b91082389e4778cb419866 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Wed, 19 Mar 2025 19:29:30 +0300 Subject: [PATCH 18/24] Add do_not_type tests --- slarnML/test/anf_conv_test.t | 14 ++++++++++ slarnML/test/dune | 15 +++++++++++ slarnML/test/lambda_lifting_test.t | 6 +++++ slarnML/test/parser_tests.t | 7 +++++ slarnML/test/riscv64_instr_test.t | 41 ++++++++++++++++++++++++++++++ 5 files changed, 83 insertions(+) diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index aba4d8ebe..dc51a7531 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -201,6 +201,20 @@ in anf_app#34))))))))))))))) ) + $ dune exec anf_conv_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec anf_conv_test < manytests/do_not_type/002if.ml + (fun main()-> + (let anf_if#1=if (true) + then ( + 1 + ) else ( + false) + in + anf_if#1) + ) + $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml + f not exist $ dune exec anf_conv_test < manytests/typed/001fac.ml (fun fac(n)-> (let anf_op#1=(n<=1) diff --git a/slarnML/test/dune b/slarnML/test/dune index 18859cd93..07dca9771 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -31,6 +31,9 @@ (cram (applies_to parser_tests) (deps + manytests/do_not_type/001.ml + manytests/do_not_type/002if.ml + manytests/do_not_type/003occurs.ml manytests/typed/001fac.ml manytests/typed/002fac.ml manytests/typed/003fib.ml @@ -47,6 +50,9 @@ (cram (applies_to clos_conv_test) (deps + manytests/do_not_type/001.ml + manytests/do_not_type/002if.ml + manytests/do_not_type/003occurs.ml manytests/typed/001fac.ml manytests/typed/002fac.ml manytests/typed/003fib.ml @@ -63,6 +69,9 @@ (cram (applies_to lambda_lifting_test) (deps + manytests/do_not_type/001.ml + manytests/do_not_type/002if.ml + manytests/do_not_type/003occurs.ml manytests/typed/001fac.ml manytests/typed/002fac.ml manytests/typed/003fib.ml @@ -79,6 +88,9 @@ (cram (applies_to anf_conv_test) (deps + manytests/do_not_type/001.ml + manytests/do_not_type/002if.ml + manytests/do_not_type/003occurs.ml manytests/typed/001fac.ml manytests/typed/002fac.ml manytests/typed/003fib.ml @@ -95,6 +107,9 @@ (cram (applies_to riscv64_instr_test) (deps + manytests/do_not_type/001.ml + manytests/do_not_type/002if.ml + manytests/do_not_type/003occurs.ml manytests/typed/001fac.ml manytests/typed/002fac.ml manytests/typed/003fib.ml diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 4e6ccab4a..4f4150adb 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -27,6 +27,12 @@ (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) (fun g(a c d)->(let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)))) (fun f(a)->(let g = (let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)) in (g (a ) 2 3)))) + $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec lambda_lifting_test < manytests/do_not_type/002if.ml + (fun main()->(if (true) then (1) else (false))) + $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml + f not exist $ dune exec lambda_lifting_test < manytests/typed/001fac.ml (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) (fun main()->(let () = ((print_int (fac 4)) in 0))) diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index d979091f7..97be29e96 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -91,6 +91,13 @@ > else (fib (n - 1) + fib (n - 2)) > EOF (let rec fib n=if ((n<2)) then (n) else ((fib->((n-1)+(fib->(n-2)))))) + $ dune exec parser_test < manytests/do_not_type/001.ml + (let recfac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) + $ dune exec parser_test < manytests/do_not_type/002if.ml + (let main=if (true) then (1) else (false)) + $ dune exec parser_test < manytests/do_not_type/003occurs.ml + (let fix f=(fun x->(f->(fun f->(x->x->f))))) + (fun x->(f->(fun f->(x->x->f)))) $ dune exec parser_test < manytests/typed/001fac.ml (let rec fac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) (let main=(let ()=(print_int->(fac->4)) in 0)) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index e34fa2e25..a5ecfd576 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -113,6 +113,47 @@ > (g 2 3) > EOF e not found + $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + addi s0,sp,32 + li t0,1 + beqz t0,.tag_if_bnch + li t1,1 + mv a0,t1 + j .tag_if_bnch_t + .tag_if_bnch: + li t2,0 + mv a0,t2 + .tag_if_bnch_t: + mv a0,a0 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 + ret + $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml + f not exist $ dune exec riscv64_instr_test < manytests/typed/001fac.ml .attribute unaligned_access, 0 .attribute stack_align, 16 From ab32ea9b889f20a0bee5ac710628dd2463956149 Mon Sep 17 00:00:00 2001 From: ioannessh Date: Thu, 20 Mar 2025 19:28:51 +0300 Subject: [PATCH 19/24] Add exec test --- slarnML/.gitignore | 14 +- slarnML/.ocamlformat | 4 +- slarnML/Makefile | 46 +- slarnML/demo/.gdb_history | 170 +- slarnML/demo/.gdbinit | 44 +- slarnML/demo/demo.ml | 23 + slarnML/demo/demoRiscv.ml | 55 - slarnML/demo/dune | 131 +- slarnML/dune-project | 66 +- slarnML/lib/riscv64/.gdbinit | 26 +- slarnML/lib/riscv64/part_app.c | 244 +-- slarnML/lib/riscv64/print.S | 172 +- slarnML/lib/riscv64/riscv.ml | 88 +- slarnML/test/anf_conv_test.t | 1294 ++++++------ slarnML/test/clos_conv_test.t | 134 +- slarnML/test/dune | 21 + slarnML/test/exec_test.t | Bin 0 -> 4185 bytes slarnML/test/lambda_lifting_test.t | 170 +- slarnML/test/parser_tests.t | 272 +-- slarnML/test/riscv64_instr_test.t | 2976 ++++++++++++++-------------- 20 files changed, 2973 insertions(+), 2977 deletions(-) create mode 100644 slarnML/demo/demo.ml delete mode 100644 slarnML/demo/demoRiscv.ml create mode 100644 slarnML/test/exec_test.t diff --git a/slarnML/.gitignore b/slarnML/.gitignore index 9be1d8541..866f5db56 100644 --- a/slarnML/.gitignore +++ b/slarnML/.gitignore @@ -1,7 +1,7 @@ -.vscode -_build -trash - -*.o -*.out -demo/main.S +.vscode +_build +trash + +*.o +*.out +demo/main.S diff --git a/slarnML/.ocamlformat b/slarnML/.ocamlformat index b0368510d..2555c2d10 100644 --- a/slarnML/.ocamlformat +++ b/slarnML/.ocamlformat @@ -1,3 +1,3 @@ -profile=janestreet -sequence-style=terminator +profile=janestreet +sequence-style=terminator max-indent=2 \ No newline at end of file diff --git a/slarnML/Makefile b/slarnML/Makefile index 3c10647e9..04a45d884 100644 --- a/slarnML/Makefile +++ b/slarnML/Makefile @@ -1,23 +1,23 @@ -.PHONY: repl tests test fmt lint celan - -all: - dune build - -repl: - dune build ./slarn.exe && rlwrap _build/default/slarn.exe - -test: - dune runtest - -clean: - @$(RM) -r _build - -fmt: - dune build @fmt --auto-promote - -lint: - dune build @lint --force - -release: - dune build --profile=release - dune runtest --profile=release +.PHONY: repl tests test fmt lint celan + +all: + dune build + +repl: + dune build ./slarn.exe && rlwrap _build/default/slarn.exe + +test: + dune runtest + +clean: + @$(RM) -r _build + +fmt: + dune build @fmt --auto-promote + +lint: + dune build @lint --force + +release: + dune build --profile=release + dune runtest --profile=release diff --git a/slarnML/demo/.gdb_history b/slarnML/demo/.gdb_history index 8460b87e4..8ac184012 100644 --- a/slarnML/demo/.gdb_history +++ b/slarnML/demo/.gdb_history @@ -1,85 +1,85 @@ -b _start -c -ni -ni -ni -ni -ni -exit -c -b main -c -b fac -c -b fac_fack -b fack_fack -b fack_fac -c -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -exit -b fac_fack -b fack_fac -c -c -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -exit +b _start +c +ni +ni +ni +ni +ni +exit +c +b main +c +b fac +c +b fac_fack +b fack_fack +b fack_fac +c +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +exit +b fac_fack +b fack_fac +c +c +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +exit diff --git a/slarnML/demo/.gdbinit b/slarnML/demo/.gdbinit index 0942d8c4e..56b06ac3f 100644 --- a/slarnML/demo/.gdbinit +++ b/slarnML/demo/.gdbinit @@ -1,23 +1,23 @@ -set history save -set architecture riscv:rv64 -set sysroot /usr/riscv64−linux−gnu -target remote :1234 -tui enable -tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 -layout example -# tui disable -focus cmd -b _start -b .breakpoint0 -b .breakpoint1 -b .breakpoint2 -b .breakpoint3 -b .breakpoint4 -b .breakpoint5 -b .breakpoint6 -b .breakpoint7 -b .breakpoint8 -b .breakpoint9 -b print_int -# c +set history save +set architecture riscv:rv64 +set sysroot /usr/riscv64−linux−gnu +target remote :1234 +tui enable +tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 +layout example +# tui disable +focus cmd +b _start +b .breakpoint0 +b .breakpoint1 +b .breakpoint2 +b .breakpoint3 +b .breakpoint4 +b .breakpoint5 +b .breakpoint6 +b .breakpoint7 +b .breakpoint8 +b .breakpoint9 +b print_int +# c # x/8xg $sp \ No newline at end of file diff --git a/slarnML/demo/demo.ml b/slarnML/demo/demo.ml new file mode 100644 index 000000000..ca6288235 --- /dev/null +++ b/slarnML/demo/demo.ml @@ -0,0 +1,23 @@ +open SlarnML_lib.Res + +let () = + let s = Stdio.In_channel.input_all Stdlib.stdin in + let result = + match SlarnML_lib.Parser.parser s with + | Ok ast -> + SlarnML_lib.Clos_conv.clos_conv ast + >>= (fun ast -> SlarnML_lib.Lambda_lifting.lambda_lifting ast) + >>= fun ast -> + Result (SlarnML_lib.Anf_conv.anf ast) + >>= (fun anf -> SlarnML_lib.Riscv.asm anf) + >>= fun prog -> + Result + (String.concat + "\n" + (List.map (SlarnML_lib.Pprint_riscv.pp_instruction "\t") prog)) + | Error message -> SlarnML_lib.Res.Error message + in + match result with + | SlarnML_lib.Res.Result r -> print_string @@ r + | Error e -> Printf.eprintf "%s" e +;; diff --git a/slarnML/demo/demoRiscv.ml b/slarnML/demo/demoRiscv.ml deleted file mode 100644 index 94a356d32..000000000 --- a/slarnML/demo/demoRiscv.ml +++ /dev/null @@ -1,55 +0,0 @@ -open SlarnML_lib.Res - -let input_file = - try Sys.argv.(1) with - | _ -> "main.ml" -;; - -let output_file = - try Sys.argv.(2) with - | _ -> "main.S" -;; - -let read_lines name : string list = - let ic = open_in name in - let try_read () = - try Some (input_line ic) with - | End_of_file -> None - in - let rec loop acc = - match try_read () with - | Some s -> loop (s :: acc) - | None -> - close_in ic; - List.rev acc - in - loop [] -;; - -let parse_to_riscv _ output_file = - let program = String.concat "\n" (read_lines input_file) ^ "\n" in - print_string program; - let ast = SlarnML_lib.Parser.parser program in - let result = - match ast with - | Ok ast -> - SlarnML_lib.Clos_conv.clos_conv ast - >>= (fun ast -> SlarnML_lib.Lambda_lifting.lambda_lifting ast) - >>= (fun ast -> Result (SlarnML_lib.Anf_conv.anf ast)) - >>= (fun anf -> SlarnML_lib.Riscv.asm anf) - >>= fun prog -> - Result - (String.concat - "\n" - (List.map (SlarnML_lib.Pprint_riscv.pp_instruction "\t") prog)) - | Error e -> SlarnML_lib.Res.Error ("there was an error: " ^ e ^ "\n") - in - match result with - | SlarnML_lib.Res.Result r -> - let oc = open_out output_file in - output_string oc (r ^ "\n"); - close_out oc - | Error e -> Printf.eprintf "%s" e -;; - -let () = parse_to_riscv input_file output_file diff --git a/slarnML/demo/dune b/slarnML/demo/dune index 614c6f187..6eba9e38c 100644 --- a/slarnML/demo/dune +++ b/slarnML/demo/dune @@ -1,65 +1,72 @@ -(rule - (targets part_app.o) - (deps ../lib/riscv64/part_app.c) - (mode - (promote (until-clean))) - (action - (run - riscv64-linux-gnu-gcc - -march=rv64gc - -O2 - -nostdlib - -nostartfiles - -ffreestanding - -c - %{deps} - -o - %{targets})) - (enabled_if - (= %{profile} demo))) - -(rule - (targets main.S) - (deps - (:gen ../demo/demoRiscv.exe) - main.ml) - (mode - (promote (until-clean))) - (action - (run %{gen} ../demo/main.ml %{targets})) - (enabled_if - (= %{profile} demo))) - -(rule - (targets main.o) - (deps main.S) - (mode - (promote (until-clean))) - (action - (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets})) - (enabled_if - (= %{profile} demo))) - -(rule - (targets print.o) - (deps ../lib/riscv64/print.S) - (mode - (promote (until-clean))) - (action - (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets})) - (enabled_if - (= %{profile} demo))) - -(rule - (targets a.out) - (deps print.o part_app.o main.o) - (mode - (promote (until-clean))) - (action - (run riscv64-linux-gnu-ld -lc %{deps} -o %{targets})) - (enabled_if - (= %{profile} demo))) - +;(rule +; (targets part_app.o) +; (deps ../lib/riscv64/part_app.c) +; (mode +; (promote (until-clean))) +; (action +; (run +; riscv64-linux-gnu-gcc +; -march=rv64gc +; -O2 +; -nostdlib +; -nostartfiles +; -ffreestanding +; -c +; %{deps} +; -o +; %{targets})) +; (enabled_if +; (= %{profile} demo))) +; +;(rule +; (targets main.S) +; (deps +; demo.ml +; main.ml) +; (mode +; (promote (until-clean))) +; (action +; (run dune exec demo < main.ml)) +; (enabled_if +; (= %{profile} demo))) +; +;(rule +; (targets main.o) +; (deps main.S) +; (mode +; (promote (until-clean))) +; (action +; (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets})) +; (enabled_if +; (= %{profile} demo))) +; +;(rule +; (targets print.o) +; (deps ../lib/riscv64/print.S) +; (mode +; (promote (until-clean))) +; (action +; (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets})) +; (enabled_if +; (= %{profile} demo))) +; +;(rule +; (targets a.out) +; (deps print.o part_app.o main.o) +; (mode +; (promote (until-clean))) +; (action +; (run riscv64-linux-gnu-ld -lc %{deps} -o %{targets})) +; (enabled_if +; (= %{profile} demo))) +; +;(executable +; (name demo) +; (public_name demo) +; (modules demo) +; (libraries slarnML.lib stdio)) +; ; (cram ; (applies_to riscvDemo) ; (deps ./a.out ./demoRiscv.exe)) +; diff --git a/slarnML/dune-project b/slarnML/dune-project index bc6dc6ea5..c4e4b8d49 100644 --- a/slarnML/dune-project +++ b/slarnML/dune-project @@ -1,33 +1,33 @@ -(lang dune 2.9) - -(name slarnML) - -(generate_opam_files true) - -(cram enable) - -(license LGPL-3.0-or-later) - -(source - (github ioannessh/comp24)) - -(authors "Ivan Shurenkov") - -(maintainers "Ivan Shurenkov") - -(package - (name slarnML) - (synopsis "SlarnML") - (version 0.0) - (depends - ocaml - dune - angstrom - base - (ppx_inline_test :with-test) - ppx_expect - ppx_deriving - bisect_ppx - (odoc :with-doc) - (ocamlformat :build))) - +(lang dune 2.9) + +(name slarnML) + +(generate_opam_files true) + +(cram enable) + +(license LGPL-3.0-or-later) + +(source + (github ioannessh/comp24)) + +(authors "Ivan Shurenkov") + +(maintainers "Ivan Shurenkov") + +(package + (name slarnML) + (synopsis "SlarnML") + (version 0.0) + (depends + ocaml + dune + angstrom + base + (ppx_inline_test :with-test) + ppx_expect + ppx_deriving + bisect_ppx + (odoc :with-doc) + (ocamlformat :build))) + diff --git a/slarnML/lib/riscv64/.gdbinit b/slarnML/lib/riscv64/.gdbinit index 98b540775..b7c4879a8 100644 --- a/slarnML/lib/riscv64/.gdbinit +++ b/slarnML/lib/riscv64/.gdbinit @@ -1,14 +1,14 @@ -set history save -set architecture riscv:rv64 -set sysroot /usr/riscv64−linux−gnu -target remote :1234 -tui enable -# tui new−layout example {−horizontal regs 1 asm 1} 2 status -# cmd 1 -tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 -layout example -# tui disable -focus cmd -b _start -c +set history save +set architecture riscv:rv64 +set sysroot /usr/riscv64−linux−gnu +target remote :1234 +tui enable +# tui new−layout example {−horizontal regs 1 asm 1} 2 status +# cmd 1 +tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 +layout example +# tui disable +focus cmd +b _start +c # x/8xg $sp \ No newline at end of file diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index 1be02822f..e54c125a3 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -1,122 +1,122 @@ -#define _GNU_SOURCE -#include -#include -#include -#include -#include -#include - -// const uint16_t MAX_APPS = 100; -// const uint8_t MAX_ARGS = 4; -#define MAX_APPS 100 -#define MAX_ARGS 4 - - -int64_t min(int64_t a, int64_t b) { - if (a < b) return a; - else return b; -} - -struct Func -{ - uint8_t argscnt; - uint8_t cnt; - void *ptr; - int64_t *argsfun; -}; -struct Func func_init(void *ptr, uint8_t cnt) { - struct Func new; - new.ptr = ptr; - new.argscnt = cnt; - new.argsfun = malloc(sizeof(int64_t)*min((int64_t)MAX_ARGS, cnt)); - new.cnt = 0; - return new; -} -struct Func *part_apps; -uint16_t last_app = 0; - -int64_t app_n(struct Func *f) { - switch ((*f).argscnt) { - case 0: - int64_t(*f_ptr0)(); - f_ptr0 = (*f).ptr; - return f_ptr0(); - case 1: - int64_t(*f_ptr1)(int64_t); - f_ptr1 = (*f).ptr; - return f_ptr1(f->argsfun[0]); - case 2: - int64_t(*f_ptr2)(int64_t, int64_t); - f_ptr2 = (*f).ptr; - return f_ptr2(f->argsfun[0], f->argsfun[1]); - case 3: - int64_t(*f_ptr3)(int64_t, int64_t, int64_t); - f_ptr3 = (*f).ptr; - return f_ptr3(f->argsfun[0], f->argsfun[1], f->argsfun[2]); - case 4: - int64_t(*f_ptr4)(int64_t, int64_t, int64_t, int64_t); - f_ptr4 = (*f).ptr; - return f_ptr4(f->argsfun[0], f->argsfun[1], f->argsfun[2], f->argsfun[3]); - default: - return -1; - } -} - -int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { - uint8_t f_cnt = f->cnt; - for (; f->cnt < min(MAX_ARGS, min(f_cnt + cnt, f->argscnt)); f->cnt++) { - f->argsfun[f->cnt] = args[f->cnt - f_cnt]; - } - int64_t ret; - if (f->cnt < f->argscnt) { - return (int64_t)f; - } else { - ret = app_n(f); - } - if (f_cnt + cnt > f->argscnt) { - int64_t new_args[MAX_ARGS]; - for (int i = f->argscnt - f_cnt; i < min(MAX_ARGS, cnt); i++) { - new_args[i - (f->argscnt - f_cnt)] = args[i]; - } - return app((void*)ret, f_cnt + cnt - f->argscnt, new_args); - } - else return ret; -} - -int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { - int cnt = 0; - int64_t args[MAX_ARGS]; - va_list argptr; - va_start(argptr, appcnt); - for (int i = 0; i < min(appcnt, MAX_ARGS); i++) { - args[i] = va_arg(argptr, int64_t); - } - va_end(argptr); - if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS]) { - part_apps[last_app] = *(struct Func *)f_ptr; - } else { - part_apps[last_app] = func_init(f_ptr, argcnt); - } - last_app = (last_app + 1) % MAX_APPS; - return app(&part_apps[last_app-1], appcnt, args); -} - -void init_part_apps() { - part_apps = malloc(sizeof(struct Func) * MAX_APPS); -} - -int many_arg(int n,int n1,int n2,int n3,int n4,int n5,int n6,int n7,int n8,int n9,int n10,int n11,int n12,int n13) { - int ret = n+n1+n3+(n4/n2)+n5+n6+n7+n8+n9+n10+n11*n12*n13; - return ret % 256; -} - -int fun ( int a, int b) -{ - return(10*a+b); -} - -int notmain () -{ - return many_arg(0,1,2,3,4,5,6,7,8,9,10,11,12,13); -} - +#define _GNU_SOURCE +#include +#include +#include +#include +#include +#include + +// const uint16_t MAX_APPS = 100; +// const uint8_t MAX_ARGS = 4; +#define MAX_APPS 100 +#define MAX_ARGS 4 + + +int64_t min(int64_t a, int64_t b) { + if (a < b) return a; + else return b; +} + +struct Func +{ + uint8_t argscnt; + uint8_t cnt; + void *ptr; + int64_t *argsfun; +}; +struct Func func_init(void *ptr, uint8_t cnt) { + struct Func new; + new.ptr = ptr; + new.argscnt = cnt; + new.argsfun = malloc(sizeof(int64_t)*min((int64_t)MAX_ARGS, cnt)); + new.cnt = 0; + return new; +} +struct Func *part_apps; +uint16_t last_app = 0; + +int64_t app_n(struct Func *f) { + switch ((*f).argscnt) { + case 0: + int64_t(*f_ptr0)(); + f_ptr0 = (*f).ptr; + return f_ptr0(); + case 1: + int64_t(*f_ptr1)(int64_t); + f_ptr1 = (*f).ptr; + return f_ptr1(f->argsfun[0]); + case 2: + int64_t(*f_ptr2)(int64_t, int64_t); + f_ptr2 = (*f).ptr; + return f_ptr2(f->argsfun[0], f->argsfun[1]); + case 3: + int64_t(*f_ptr3)(int64_t, int64_t, int64_t); + f_ptr3 = (*f).ptr; + return f_ptr3(f->argsfun[0], f->argsfun[1], f->argsfun[2]); + case 4: + int64_t(*f_ptr4)(int64_t, int64_t, int64_t, int64_t); + f_ptr4 = (*f).ptr; + return f_ptr4(f->argsfun[0], f->argsfun[1], f->argsfun[2], f->argsfun[3]); + default: + return -1; + } +} + +int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { + uint8_t f_cnt = f->cnt; + for (; f->cnt < min(MAX_ARGS, min(f_cnt + cnt, f->argscnt)); f->cnt++) { + f->argsfun[f->cnt] = args[f->cnt - f_cnt]; + } + int64_t ret; + if (f->cnt < f->argscnt) { + return (int64_t)f; + } else { + ret = app_n(f); + } + if (f_cnt + cnt > f->argscnt) { + int64_t new_args[MAX_ARGS]; + for (int i = f->argscnt - f_cnt; i < min(MAX_ARGS, cnt); i++) { + new_args[i - (f->argscnt - f_cnt)] = args[i]; + } + return app((void*)ret, f_cnt + cnt - f->argscnt, new_args); + } + else return ret; +} + +int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { + int cnt = 0; + int64_t args[MAX_ARGS]; + va_list argptr; + va_start(argptr, appcnt); + for (int i = 0; i < min(appcnt, MAX_ARGS); i++) { + args[i] = va_arg(argptr, int64_t); + } + va_end(argptr); + if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS]) { + part_apps[last_app] = *(struct Func *)f_ptr; + } else { + part_apps[last_app] = func_init(f_ptr, argcnt); + } + last_app = (last_app + 1) % MAX_APPS; + return app(&part_apps[last_app-1], appcnt, args); +} + +void init_part_apps() { + part_apps = malloc(sizeof(struct Func) * MAX_APPS); +} + +int many_arg(int n,int n1,int n2,int n3,int n4,int n5,int n6,int n7,int n8,int n9,int n10,int n11,int n12,int n13) { + int ret = n+n1+n3+(n4/n2)+n5+n6+n7+n8+n9+n10+n11*n12*n13; + return ret % 256; +} + +int fun ( int a, int b) +{ + return(10*a+b); +} + +int notmain () +{ + return many_arg(0,1,2,3,4,5,6,7,8,9,10,11,12,13); +} + diff --git a/slarnML/lib/riscv64/print.S b/slarnML/lib/riscv64/print.S index f06f04e82..3899d2f7e 100644 --- a/slarnML/lib/riscv64/print.S +++ b/slarnML/lib/riscv64/print.S @@ -1,86 +1,86 @@ -.global print_char -.global print_int - -print_char: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - - sd a0,-24(s0) - addi a1,s0,-24 - li a0, 1 - li a7, 64 - li a2, 1 - ecall - - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 - ret - -print_uint: - addi sp,sp,-64 - sd ra,56(sp) - sd s0,48(sp) - addi s0,sp,64 - - li t0,10 # const - li t1, 8 - li a2, 0 # buffer_size - addi s1,s0,-24 - - .loop1: - li a4,0 - li t2,0 - .loop2: - rem a5,a0,t0 - addi a5,a5,48 - slli a4,a4, 8 - add a4,a4,a5 - addi t2,t2, 1 - div a0,a0,t0 - - beq t1,t2, .end_loop2 - beqz a0, .end_loop2 - j .loop2 - .end_loop2: - sd a4,0(s1) - addi a2,a2, 8 - addi s1,s1,-8 - beqz a0, .end_loop1 - j .loop1 - .end_loop1: - - li a0, 1 - addi a1,s1,8 # & - li a7, 64 # write - ecall - - - ld ra,56(sp) - ld s0,48(sp) - addi sp,sp,64 - ret - -print_int: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 - - bge a0,zero, .posit - li a3,-1 - mul a0,a0,a3 - sd a0,-24(s0) - li a0,45 # '-' - call print_char - - ld a0,-24(s0) - .posit: - call print_uint - - ld ra,40(sp) - ld s0,32(sp) - addi sp,sp,48 - ret +.global print_char +.global print_int + +print_char: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + + sd a0,-24(s0) + addi a1,s0,-24 + li a0, 1 + li a7, 64 + li a2, 1 + ecall + + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + +print_uint: + addi sp,sp,-64 + sd ra,56(sp) + sd s0,48(sp) + addi s0,sp,64 + + li t0,10 # const + li t1, 8 + li a2, 0 # buffer_size + addi s1,s0,-24 + + .loop1: + li a4,0 + li t2,0 + .loop2: + rem a5,a0,t0 + addi a5,a5,48 + slli a4,a4, 8 + add a4,a4,a5 + addi t2,t2, 1 + div a0,a0,t0 + + beq t1,t2, .end_loop2 + beqz a0, .end_loop2 + j .loop2 + .end_loop2: + sd a4,0(s1) + addi a2,a2, 8 + addi s1,s1,-8 + beqz a0, .end_loop1 + j .loop1 + .end_loop1: + + li a0, 1 + addi a1,s1,8 # & + li a7, 64 # write + ecall + + + ld ra,56(sp) + ld s0,48(sp) + addi sp,sp,64 + ret + +print_int: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + + bge a0,zero, .posit + li a3,-1 + mul a0,a0,a3 + sd a0,-24(s0) + li a0,45 # '-' + call print_char + + ld a0,-24(s0) + .posit: + call print_uint + + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index eb1270d81..ed8cf4daa 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -309,15 +309,15 @@ let init_args args res = >>= fun c_env -> res >>= (fun env -> - fold_right - (fun a r -> - r - >>= fun (offset, lst, e) -> - Result e - |> s_right_arg offset a - >>= fun (instr, e) -> Result (offset - 8, instr @ lst, e)) - right - (Result ((r_len - 1) * 8, [], env))) + fold_right + (fun a r -> + r + >>= fun (offset, lst, e) -> + Result e + |> s_right_arg offset a + >>= fun (instr, e) -> Result (offset - 8, instr @ lst, e)) + right + (Result ((r_len - 1) * 8, [], env))) >>= fun (_, right, env) -> fold_left (fun r a -> @@ -476,24 +476,24 @@ let rec build_aexpr tag a res = let dflt_bnch res = res >>= (fun (instr0, reg, env) -> - Result ([], None, env) - |> build_aexpr tag e1 - >>= fun (instr1, reg1, env) -> - (match reg1 with - | Some reg when reg <> A 0 -> - Result env - |> free_a0 - >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) - | Some _ -> Result ([], env) - | _ -> Error "Error in if") - >>= fun (instr2, env) -> - Result - ( instr0 - @ (Beqz (reg, get_tag_addr id) :: instr1) - @ instr2 - @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] - , Some (A 0) - , env )) + Result ([], None, env) + |> build_aexpr tag e1 + >>= fun (instr1, reg1, env) -> + (match reg1 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result + ( instr0 + @ (Beqz (reg, get_tag_addr id) :: instr1) + @ instr2 + @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] + , Some (A 0) + , env )) |> build_aexpr tag e2 >>= fun (instr1, reg2, env) -> (match reg2 with @@ -515,23 +515,23 @@ let rec build_aexpr tag a res = | Some (_, cond) -> res >>= (fun env -> - Result ([], None, env) - |> build_aexpr tag e1 - >>= fun (instr1, reg1, env) -> - (match reg1 with - | Some reg when reg <> A 0 -> - Result env - |> free_a0 - >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) - | Some _ -> Result ([], env) - | _ -> Error "Error in if") - >>= fun (instr2, env) -> - Result - ( (cond :: instr1) - @ instr2 - @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] - , Some (A 0) - , env )) + Result ([], None, env) + |> build_aexpr tag e1 + >>= fun (instr1, reg1, env) -> + (match reg1 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result + ( (cond :: instr1) + @ instr2 + @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] + , Some (A 0) + , env )) |> build_aexpr tag e2 >>= fun (instr1, reg2, env) -> (match reg2 with diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index dc51a7531..205e43e00 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -1,647 +1,647 @@ - $ dune exec anf_conv_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - (fun anon$1(n f x)-> - (let anf_app#1=(n ) - in - (let anf_app#2=(f anf_app#1) - in - (let anf_op#3=(x*anf_app#2) - in - anf_op#3))) - ) - (fun fack(n f)-> - (let anf_op#4=(n<=1) - in - (let anf_if#5=if (anf_op#4) - then ( - (let anf_app#6=(f 1) - in - anf_app#6) - ) else ( - (let anf_op#7=(n-1) - in - (let anf_app#8=(n ) - in - (let anf_app#9=(f ) - in - (let anf_app#10=(anon$1 anf_app#8 anf_app#9) - in - (let anf_app#11=(fack anf_op#7 anf_app#10) - in - anf_app#11)))))) - in - anf_if#5)) - ) - (fun anon$2(x)-> - x - ) - (fun fac(n)-> - (let anf_op#12=(n<=1) - in - (let anf_if#13=if (anf_op#12) - then ( - (let anf_app#14=(f 1) - in - anf_app#14) - ) else ( - (let anf_op#15=(n-1) - in - (let anf_app#16=(n ) - in - (let anf_app#17=(f ) - in - (let anf_app#18=(anon$1 anf_app#16 anf_app#17) - in - (let anf_app#19=(fack anf_op#15 anf_app#18) - in - anf_app#19)))))) - in - (let anf_fack#20=(anf_if#13 ) - in - (let anf_app#21=(n ) - in - (let anf_app#22=(anon$2 ) - in - (let anf_app#23=(fack anf_app#21 anf_app#22) - in - anf_app#23)))))) - ) - $ dune exec anf_conv_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - (fun fack(n)-> - (let anf_op#1=(n<1) - in - (let anf_if#2=if (anf_op#1) - then ( - n - ) else ( - (let anf_op#3=(n-1) - in - (let anf_app#4=(fack anf_op#3) - in - (let anf_op#5=(n*anf_app#4) - in - anf_op#5)))) - in - anf_if#2)) - ) - (fun fac(n)-> - (let anf_op#6=(n<1) - in - (let anf_if#7=if (anf_op#6) - then ( - n - ) else ( - (let anf_op#8=(n-1) - in - (let anf_app#9=(fack anf_op#8) - in - (let anf_op#10=(n*anf_app#9) - in - anf_op#10)))) - in - (let anf_fack#11=(anf_if#7 ) - in - (let anf_app#12=(n ) - in - (let anf_app#13=(fack anf_app#12) - in - anf_app#13))))) - ) - $ dune exec anf_conv_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - (fun h(a c d e)-> - (let anf_app#1=(a ) - in - (let anf_app#2=(c ) - in - (let anf_app#3=(d ) - in - (let anf_app#4=(e ) - in - (let anf_op#5=(anf_app#3*anf_app#4) - in - (let anf_op#6=(anf_app#2+anf_op#5) - in - (let anf_op#7=(anf_app#1*anf_op#6) - in - anf_op#7))))))) - ) - (fun g(a c d)-> - (let anf_app#8=(a ) - in - (let anf_app#9=(c ) - in - (let anf_app#10=(d ) - in - (let anf_app#11=(e ) - in - (let anf_op#12=(anf_app#10*anf_app#11) - in - (let anf_op#13=(anf_app#9+anf_op#12) - in - (let anf_op#14=(anf_app#8*anf_op#13) - in - (let anf_h#15=(anf_op#14 ) - in - (let anf_app#16=(a ) - in - (let anf_app#17=(c ) - in - (let anf_app#18=(d ) - in - (let anf_app#19=(h anf_app#16 anf_app#17 anf_app#18 4) - in - anf_app#19)))))))))))) - ) - (fun f(a)-> - (let anf_app#20=(a ) - in - (let anf_app#21=(c ) - in - (let anf_app#22=(d ) - in - (let anf_app#23=(e ) - in - (let anf_op#24=(anf_app#22*anf_app#23) - in - (let anf_op#25=(anf_app#21+anf_op#24) - in - (let anf_op#26=(anf_app#20*anf_op#25) - in - (let anf_h#27=(anf_op#26 ) - in - (let anf_app#28=(a ) - in - (let anf_app#29=(c ) - in - (let anf_app#30=(d ) - in - (let anf_app#31=(h anf_app#28 anf_app#29 anf_app#30 4) - in - (let anf_g#32=(anf_app#31 ) - in - (let anf_app#33=(a ) - in - (let anf_app#34=(g anf_app#33 2 3) - in - anf_app#34))))))))))))))) - ) - $ dune exec anf_conv_test < manytests/do_not_type/001.ml - fac not exist - $ dune exec anf_conv_test < manytests/do_not_type/002if.ml - (fun main()-> - (let anf_if#1=if (true) - then ( - 1 - ) else ( - false) - in - anf_if#1) - ) - $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml - f not exist - $ dune exec anf_conv_test < manytests/typed/001fac.ml - (fun fac(n)-> - (let anf_op#1=(n<=1) - in - (let anf_if#2=if (anf_op#1) - then ( - 1 - ) else ( - (let anf_op#3=(n-1) - in - (let anf_app#4=(fac anf_op#3) - in - (let anf_op#5=(n*anf_app#4) - in - anf_op#5)))) - in - anf_if#2)) - ) - (fun main()-> - (let anf_app#6=(fac 4) - in - (let anf_app#7=(print_int anf_app#6) - in - (let anf_()#8=(anf_app#7 ) - in - 0))) - ) - $ dune exec anf_conv_test < manytests/typed/002fac.ml - (fun anon$1(n k p)-> - (let anf_op#1=(p*n) - in - (let anf_app#2=(k anf_op#1) - in - anf_app#2)) - ) - (fun fac_cps(n k)-> - (let anf_op#3=(n=1) - in - (let anf_if#4=if (anf_op#3) - then ( - (let anf_app#5=(k 1) - in - anf_app#5) - ) else ( - (let anf_op#6=(n-1) - in - (let anf_app#7=(n ) - in - (let anf_app#8=(k ) - in - (let anf_app#9=(anon$1 anf_app#7 anf_app#8) - in - (let anf_app#10=(fac_cps anf_op#6 anf_app#9) - in - anf_app#10)))))) - in - anf_if#4)) - ) - (fun anon$1(print_int)-> - print_int - ) - (fun main()-> - (let anf_app#11=(anon$1 ) - in - (let anf_app#12=(fac_cps 4 anf_app#11) - in - (let anf_app#13=(print_int anf_app#12) - in - (let anf_()#14=(anf_app#13 ) - in - 0)))) - ) - $ dune exec anf_conv_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/004manyargs.ml - (fun wrap(f)-> - (let anf_op#1=(1=1) - in - (let anf_if#2=if (anf_op#1) - then ( - (let anf_app#3=(f ) - in - anf_app#3) - ) else ( - (let anf_app#4=(f ) - in - anf_app#4)) - in - anf_if#2)) - ) - (fun a(a)-> - (let anf_app#5=(a ) - in - (let anf_app#6=(print_int anf_app#5) - in - anf_app#6)) - ) - (fun b(b)-> - (let anf_app#7=(b ) - in - (let anf_app#8=(print_int anf_app#7) - in - anf_app#8)) - ) - (fun c(c)-> - (let anf_app#9=(c ) - in - (let anf_app#10=(print_int anf_app#9) - in - anf_app#10)) - ) - (fun test3(a b c)-> - (let anf_app#11=(a ) - in - (let anf_app#12=(print_int anf_app#11) - in - (let anf_a#13=(anf_app#12 ) - in - (let anf_app#14=(b ) - in - (let anf_app#15=(print_int anf_app#14) - in - (let anf_b#16=(anf_app#15 ) - in - (let anf_app#17=(c ) - in - (let anf_app#18=(print_int anf_app#17) - in - (let anf_c#19=(anf_app#18 ) - in - 0))))))))) - ) - (fun test10(a b c d e f g h i j)-> - (let anf_app#20=(a ) - in - (let anf_app#21=(b ) - in - (let anf_op#22=(anf_app#20+anf_app#21) - in - (let anf_app#23=(c ) - in - (let anf_op#24=(anf_op#22+anf_app#23) - in - (let anf_app#25=(d ) - in - (let anf_op#26=(anf_op#24+anf_app#25) - in - (let anf_app#27=(e ) - in - (let anf_op#28=(anf_op#26+anf_app#27) - in - (let anf_app#29=(f ) - in - (let anf_op#30=(anf_op#28+anf_app#29) - in - (let anf_app#31=(g ) - in - (let anf_op#32=(anf_op#30+anf_app#31) - in - (let anf_app#33=(h ) - in - (let anf_op#34=(anf_op#32+anf_app#33) - in - (let anf_app#35=(i ) - in - (let anf_op#36=(anf_op#34+anf_app#35) - in - (let anf_app#37=(j ) - in - (let anf_op#38=(anf_op#36+anf_app#37) - in - anf_op#38))))))))))))))))))) - ) - (fun temp0()-> - (let anf_app#39=(test10 ) - in - (let anf_app#40=(wrap anf_app#39 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) - in - anf_app#40)) - ) - (fun temp1(temp0)-> - (let anf_app#41=(temp0 ) - in - (let anf_app#42=(print_int anf_app#41) - in - anf_app#42)) - ) - (fun temp2()-> - (let anf_app#43=(test3 ) - in - (let anf_app#44=(wrap anf_app#43 1 10 100) - in - anf_app#44)) - ) - (fun main()-> - (let anf_app#45=(test10 ) - in - (let anf_app#46=(wrap anf_app#45 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) - in - (let anf_temp0#47=(anf_app#46 ) - in - (let anf_app#48=(temp0 ) - in - (let anf_app#49=(print_int anf_app#48) - in - (let anf_temp1#50=(anf_app#49 ) - in - (let anf_app#51=(test3 ) - in - (let anf_app#52=(wrap anf_app#51 1 10 100) - in - (let anf_temp2#53=(anf_app#52 ) - in - 0))))))))) - ) - $ dune exec anf_conv_test < manytests/typed/005fix.ml - (fun fix(f x)-> - (let anf_app#1=(f ) - in - (let anf_app#2=(fix anf_app#1) - in - (let anf_app#3=(x ) - in - (let anf_app#4=(f anf_app#2 anf_app#3) - in - anf_app#4)))) - ) - (fun fac(self n)-> - (let anf_app#5=(n ) - in - (let anf_op#6=(anf_app#5<=1) - in - (let anf_if#7=if (anf_op#6) - then ( - 1 - ) else ( - (let anf_app#8=(n ) - in - (let anf_app#9=(n ) - in - (let anf_op#10=(anf_app#9-1) - in - (let anf_app#11=(self anf_op#10) - in - (let anf_op#12=(anf_app#8*anf_app#11) - in - anf_op#12)))))) - in - anf_if#7))) - ) - (fun main()-> - (let anf_app#13=(fac ) - in - (let anf_app#14=(fix anf_app#13 6) - in - (let anf_app#15=(print_int anf_app#14) - in - (let anf_()#16=(anf_app#15 ) - in - 0)))) - ) - $ dune exec anf_conv_test < manytests/typed/006partial.ml - (fun anon$1(foo)-> - (let anf_op#1=(foo+2) - in - anf_op#1) - ) - (fun anon$2(foo)-> - (let anf_op#2=(foo*10) - in - anf_op#2) - ) - (fun foo(b)-> - (let anf_app#3=(b ) - in - (let anf_if#4=if (anf_app#3) - then ( - (let anf_app#5=(anon$1 ) - in - anf_app#5) - ) else ( - (let anf_app#6=(anon$2 ) - in - anf_app#6)) - in - anf_if#4)) - ) - (fun foo(x)-> - (let anf_app#7=(x ) - in - (let anf_app#8=(foo false anf_app#7) - in - (let anf_app#9=(foo true anf_app#8) - in - (let anf_app#10=(foo false anf_app#9) - in - (let anf_app#11=(foo true anf_app#10) - in - anf_app#11))))) - ) - (fun main()-> - (let anf_app#12=(foo 11) - in - (let anf_app#13=(print_int anf_app#12) - in - (let anf_()#14=(anf_app#13 ) - in - 0))) - ) - $ dune exec anf_conv_test < manytests/typed/006partial2.ml - (fun foo(a b c)-> - (let anf_app#1=(a ) - in - (let anf_app#2=(print_int anf_app#1) - in - (let anf_()#3=(anf_app#2 ) - in - (let anf_app#4=(b ) - in - (let anf_app#5=(print_int anf_app#4) - in - (let anf_()#6=(anf_app#5 ) - in - (let anf_app#7=(c ) - in - (let anf_app#8=(print_int anf_app#7) - in - (let anf_()#9=(anf_app#8 ) - in - (let anf_app#10=(a ) - in - (let anf_app#11=(b ) - in - (let anf_app#12=(c ) - in - (let anf_op#13=(anf_app#11*anf_app#12) - in - (let anf_op#14=(anf_app#10+anf_op#13) - in - anf_op#14)))))))))))))) - ) - (fun foo()-> - (let anf_app#15=(foo 1) - in - anf_app#15) - ) - (fun foo(foo)-> - (let anf_app#16=(foo ) - in - (let anf_app#17=(foo anf_app#16 2) - in - anf_app#17)) - ) - (fun foo(foo)-> - (let anf_app#18=(foo ) - in - (let anf_app#19=(foo anf_app#18 3) - in - anf_app#19)) - ) - (fun main()-> - (let anf_app#20=(foo 1) - in - (let anf_foo#21=(anf_app#20 ) - in - (let anf_app#22=(foo ) - in - (let anf_app#23=(foo anf_app#22 2) - in - (let anf_foo#24=(anf_app#23 ) - in - (let anf_app#25=(foo ) - in - (let anf_app#26=(foo anf_app#25 3) - in - (let anf_foo#27=(anf_app#26 ) - in - (let anf_app#28=(foo ) - in - (let anf_app#29=(print_int anf_app#28) - in - (let anf_()#30=(anf_app#29 ) - in - 0))))))))))) - ) - $ dune exec anf_conv_test < manytests/typed/006partial3.ml - (fun anon$2(c)-> - (let anf_app#1=(c ) - in - (let anf_app#2=(print_int anf_app#1) - in - anf_app#2)) - ) - (fun anon$1(b)-> - (let anf_app#3=(b ) - in - (let anf_app#4=(print_int anf_app#3) - in - (let anf_()#5=(anf_app#4 ) - in - (let anf_app#6=(anon$2 ) - in - anf_app#6)))) - ) - (fun foo(a)-> - (let anf_app#7=(a ) - in - (let anf_app#8=(print_int anf_app#7) - in - (let anf_()#9=(anf_app#8 ) - in - (let anf_app#10=(anon$1 ) - in - anf_app#10)))) - ) - (fun main()-> - (let anf_app#11=(foo 4 8 9) - in - (let anf_()#12=(anf_app#11 ) - in - 0)) - ) - $ dune exec anf_conv_test < manytests/typed/007order.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec anf_conv_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (fun anon$1(n f x)-> + (let anf_app#1=(n ) + in + (let anf_app#2=(f anf_app#1) + in + (let anf_op#3=(x*anf_app#2) + in + anf_op#3))) + ) + (fun fack(n f)-> + (let anf_op#4=(n<=1) + in + (let anf_if#5=if (anf_op#4) + then ( + (let anf_app#6=(f 1) + in + anf_app#6) + ) else ( + (let anf_op#7=(n-1) + in + (let anf_app#8=(n ) + in + (let anf_app#9=(f ) + in + (let anf_app#10=(anon$1 anf_app#8 anf_app#9) + in + (let anf_app#11=(fack anf_op#7 anf_app#10) + in + anf_app#11)))))) + in + anf_if#5)) + ) + (fun anon$2(x)-> + x + ) + (fun fac(n)-> + (let anf_op#12=(n<=1) + in + (let anf_if#13=if (anf_op#12) + then ( + (let anf_app#14=(f 1) + in + anf_app#14) + ) else ( + (let anf_op#15=(n-1) + in + (let anf_app#16=(n ) + in + (let anf_app#17=(f ) + in + (let anf_app#18=(anon$1 anf_app#16 anf_app#17) + in + (let anf_app#19=(fack anf_op#15 anf_app#18) + in + anf_app#19)))))) + in + (let anf_fack#20=(anf_if#13 ) + in + (let anf_app#21=(n ) + in + (let anf_app#22=(anon$2 ) + in + (let anf_app#23=(fack anf_app#21 anf_app#22) + in + anf_app#23)))))) + ) + $ dune exec anf_conv_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (fun fack(n)-> + (let anf_op#1=(n<1) + in + (let anf_if#2=if (anf_op#1) + then ( + n + ) else ( + (let anf_op#3=(n-1) + in + (let anf_app#4=(fack anf_op#3) + in + (let anf_op#5=(n*anf_app#4) + in + anf_op#5)))) + in + anf_if#2)) + ) + (fun fac(n)-> + (let anf_op#6=(n<1) + in + (let anf_if#7=if (anf_op#6) + then ( + n + ) else ( + (let anf_op#8=(n-1) + in + (let anf_app#9=(fack anf_op#8) + in + (let anf_op#10=(n*anf_app#9) + in + anf_op#10)))) + in + (let anf_fack#11=(anf_if#7 ) + in + (let anf_app#12=(n ) + in + (let anf_app#13=(fack anf_app#12) + in + anf_app#13))))) + ) + $ dune exec anf_conv_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (fun h(a c d e)-> + (let anf_app#1=(a ) + in + (let anf_app#2=(c ) + in + (let anf_app#3=(d ) + in + (let anf_app#4=(e ) + in + (let anf_op#5=(anf_app#3*anf_app#4) + in + (let anf_op#6=(anf_app#2+anf_op#5) + in + (let anf_op#7=(anf_app#1*anf_op#6) + in + anf_op#7))))))) + ) + (fun g(a c d)-> + (let anf_app#8=(a ) + in + (let anf_app#9=(c ) + in + (let anf_app#10=(d ) + in + (let anf_app#11=(e ) + in + (let anf_op#12=(anf_app#10*anf_app#11) + in + (let anf_op#13=(anf_app#9+anf_op#12) + in + (let anf_op#14=(anf_app#8*anf_op#13) + in + (let anf_h#15=(anf_op#14 ) + in + (let anf_app#16=(a ) + in + (let anf_app#17=(c ) + in + (let anf_app#18=(d ) + in + (let anf_app#19=(h anf_app#16 anf_app#17 anf_app#18 4) + in + anf_app#19)))))))))))) + ) + (fun f(a)-> + (let anf_app#20=(a ) + in + (let anf_app#21=(c ) + in + (let anf_app#22=(d ) + in + (let anf_app#23=(e ) + in + (let anf_op#24=(anf_app#22*anf_app#23) + in + (let anf_op#25=(anf_app#21+anf_op#24) + in + (let anf_op#26=(anf_app#20*anf_op#25) + in + (let anf_h#27=(anf_op#26 ) + in + (let anf_app#28=(a ) + in + (let anf_app#29=(c ) + in + (let anf_app#30=(d ) + in + (let anf_app#31=(h anf_app#28 anf_app#29 anf_app#30 4) + in + (let anf_g#32=(anf_app#31 ) + in + (let anf_app#33=(a ) + in + (let anf_app#34=(g anf_app#33 2 3) + in + anf_app#34))))))))))))))) + ) + $ dune exec anf_conv_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec anf_conv_test < manytests/do_not_type/002if.ml + (fun main()-> + (let anf_if#1=if (true) + then ( + 1 + ) else ( + false) + in + anf_if#1) + ) + $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml + f not exist + $ dune exec anf_conv_test < manytests/typed/001fac.ml + (fun fac(n)-> + (let anf_op#1=(n<=1) + in + (let anf_if#2=if (anf_op#1) + then ( + 1 + ) else ( + (let anf_op#3=(n-1) + in + (let anf_app#4=(fac anf_op#3) + in + (let anf_op#5=(n*anf_app#4) + in + anf_op#5)))) + in + anf_if#2)) + ) + (fun main()-> + (let anf_app#6=(fac 4) + in + (let anf_app#7=(print_int anf_app#6) + in + (let anf_()#8=(anf_app#7 ) + in + 0))) + ) + $ dune exec anf_conv_test < manytests/typed/002fac.ml + (fun anon$1(n k p)-> + (let anf_op#1=(p*n) + in + (let anf_app#2=(k anf_op#1) + in + anf_app#2)) + ) + (fun fac_cps(n k)-> + (let anf_op#3=(n=1) + in + (let anf_if#4=if (anf_op#3) + then ( + (let anf_app#5=(k 1) + in + anf_app#5) + ) else ( + (let anf_op#6=(n-1) + in + (let anf_app#7=(n ) + in + (let anf_app#8=(k ) + in + (let anf_app#9=(anon$1 anf_app#7 anf_app#8) + in + (let anf_app#10=(fac_cps anf_op#6 anf_app#9) + in + anf_app#10)))))) + in + anf_if#4)) + ) + (fun anon$1(print_int)-> + print_int + ) + (fun main()-> + (let anf_app#11=(anon$1 ) + in + (let anf_app#12=(fac_cps 4 anf_app#11) + in + (let anf_app#13=(print_int anf_app#12) + in + (let anf_()#14=(anf_app#13 ) + in + 0)))) + ) + $ dune exec anf_conv_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/004manyargs.ml + (fun wrap(f)-> + (let anf_op#1=(1=1) + in + (let anf_if#2=if (anf_op#1) + then ( + (let anf_app#3=(f ) + in + anf_app#3) + ) else ( + (let anf_app#4=(f ) + in + anf_app#4)) + in + anf_if#2)) + ) + (fun a(a)-> + (let anf_app#5=(a ) + in + (let anf_app#6=(print_int anf_app#5) + in + anf_app#6)) + ) + (fun b(b)-> + (let anf_app#7=(b ) + in + (let anf_app#8=(print_int anf_app#7) + in + anf_app#8)) + ) + (fun c(c)-> + (let anf_app#9=(c ) + in + (let anf_app#10=(print_int anf_app#9) + in + anf_app#10)) + ) + (fun test3(a b c)-> + (let anf_app#11=(a ) + in + (let anf_app#12=(print_int anf_app#11) + in + (let anf_a#13=(anf_app#12 ) + in + (let anf_app#14=(b ) + in + (let anf_app#15=(print_int anf_app#14) + in + (let anf_b#16=(anf_app#15 ) + in + (let anf_app#17=(c ) + in + (let anf_app#18=(print_int anf_app#17) + in + (let anf_c#19=(anf_app#18 ) + in + 0))))))))) + ) + (fun test10(a b c d e f g h i j)-> + (let anf_app#20=(a ) + in + (let anf_app#21=(b ) + in + (let anf_op#22=(anf_app#20+anf_app#21) + in + (let anf_app#23=(c ) + in + (let anf_op#24=(anf_op#22+anf_app#23) + in + (let anf_app#25=(d ) + in + (let anf_op#26=(anf_op#24+anf_app#25) + in + (let anf_app#27=(e ) + in + (let anf_op#28=(anf_op#26+anf_app#27) + in + (let anf_app#29=(f ) + in + (let anf_op#30=(anf_op#28+anf_app#29) + in + (let anf_app#31=(g ) + in + (let anf_op#32=(anf_op#30+anf_app#31) + in + (let anf_app#33=(h ) + in + (let anf_op#34=(anf_op#32+anf_app#33) + in + (let anf_app#35=(i ) + in + (let anf_op#36=(anf_op#34+anf_app#35) + in + (let anf_app#37=(j ) + in + (let anf_op#38=(anf_op#36+anf_app#37) + in + anf_op#38))))))))))))))))))) + ) + (fun temp0()-> + (let anf_app#39=(test10 ) + in + (let anf_app#40=(wrap anf_app#39 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + in + anf_app#40)) + ) + (fun temp1(temp0)-> + (let anf_app#41=(temp0 ) + in + (let anf_app#42=(print_int anf_app#41) + in + anf_app#42)) + ) + (fun temp2()-> + (let anf_app#43=(test3 ) + in + (let anf_app#44=(wrap anf_app#43 1 10 100) + in + anf_app#44)) + ) + (fun main()-> + (let anf_app#45=(test10 ) + in + (let anf_app#46=(wrap anf_app#45 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + in + (let anf_temp0#47=(anf_app#46 ) + in + (let anf_app#48=(temp0 ) + in + (let anf_app#49=(print_int anf_app#48) + in + (let anf_temp1#50=(anf_app#49 ) + in + (let anf_app#51=(test3 ) + in + (let anf_app#52=(wrap anf_app#51 1 10 100) + in + (let anf_temp2#53=(anf_app#52 ) + in + 0))))))))) + ) + $ dune exec anf_conv_test < manytests/typed/005fix.ml + (fun fix(f x)-> + (let anf_app#1=(f ) + in + (let anf_app#2=(fix anf_app#1) + in + (let anf_app#3=(x ) + in + (let anf_app#4=(f anf_app#2 anf_app#3) + in + anf_app#4)))) + ) + (fun fac(self n)-> + (let anf_app#5=(n ) + in + (let anf_op#6=(anf_app#5<=1) + in + (let anf_if#7=if (anf_op#6) + then ( + 1 + ) else ( + (let anf_app#8=(n ) + in + (let anf_app#9=(n ) + in + (let anf_op#10=(anf_app#9-1) + in + (let anf_app#11=(self anf_op#10) + in + (let anf_op#12=(anf_app#8*anf_app#11) + in + anf_op#12)))))) + in + anf_if#7))) + ) + (fun main()-> + (let anf_app#13=(fac ) + in + (let anf_app#14=(fix anf_app#13 6) + in + (let anf_app#15=(print_int anf_app#14) + in + (let anf_()#16=(anf_app#15 ) + in + 0)))) + ) + $ dune exec anf_conv_test < manytests/typed/006partial.ml + (fun anon$1(foo)-> + (let anf_op#1=(foo+2) + in + anf_op#1) + ) + (fun anon$2(foo)-> + (let anf_op#2=(foo*10) + in + anf_op#2) + ) + (fun foo(b)-> + (let anf_app#3=(b ) + in + (let anf_if#4=if (anf_app#3) + then ( + (let anf_app#5=(anon$1 ) + in + anf_app#5) + ) else ( + (let anf_app#6=(anon$2 ) + in + anf_app#6)) + in + anf_if#4)) + ) + (fun foo(x)-> + (let anf_app#7=(x ) + in + (let anf_app#8=(foo false anf_app#7) + in + (let anf_app#9=(foo true anf_app#8) + in + (let anf_app#10=(foo false anf_app#9) + in + (let anf_app#11=(foo true anf_app#10) + in + anf_app#11))))) + ) + (fun main()-> + (let anf_app#12=(foo 11) + in + (let anf_app#13=(print_int anf_app#12) + in + (let anf_()#14=(anf_app#13 ) + in + 0))) + ) + $ dune exec anf_conv_test < manytests/typed/006partial2.ml + (fun foo(a b c)-> + (let anf_app#1=(a ) + in + (let anf_app#2=(print_int anf_app#1) + in + (let anf_()#3=(anf_app#2 ) + in + (let anf_app#4=(b ) + in + (let anf_app#5=(print_int anf_app#4) + in + (let anf_()#6=(anf_app#5 ) + in + (let anf_app#7=(c ) + in + (let anf_app#8=(print_int anf_app#7) + in + (let anf_()#9=(anf_app#8 ) + in + (let anf_app#10=(a ) + in + (let anf_app#11=(b ) + in + (let anf_app#12=(c ) + in + (let anf_op#13=(anf_app#11*anf_app#12) + in + (let anf_op#14=(anf_app#10+anf_op#13) + in + anf_op#14)))))))))))))) + ) + (fun foo()-> + (let anf_app#15=(foo 1) + in + anf_app#15) + ) + (fun foo(foo)-> + (let anf_app#16=(foo ) + in + (let anf_app#17=(foo anf_app#16 2) + in + anf_app#17)) + ) + (fun foo(foo)-> + (let anf_app#18=(foo ) + in + (let anf_app#19=(foo anf_app#18 3) + in + anf_app#19)) + ) + (fun main()-> + (let anf_app#20=(foo 1) + in + (let anf_foo#21=(anf_app#20 ) + in + (let anf_app#22=(foo ) + in + (let anf_app#23=(foo anf_app#22 2) + in + (let anf_foo#24=(anf_app#23 ) + in + (let anf_app#25=(foo ) + in + (let anf_app#26=(foo anf_app#25 3) + in + (let anf_foo#27=(anf_app#26 ) + in + (let anf_app#28=(foo ) + in + (let anf_app#29=(print_int anf_app#28) + in + (let anf_()#30=(anf_app#29 ) + in + 0))))))))))) + ) + $ dune exec anf_conv_test < manytests/typed/006partial3.ml + (fun anon$2(c)-> + (let anf_app#1=(c ) + in + (let anf_app#2=(print_int anf_app#1) + in + anf_app#2)) + ) + (fun anon$1(b)-> + (let anf_app#3=(b ) + in + (let anf_app#4=(print_int anf_app#3) + in + (let anf_()#5=(anf_app#4 ) + in + (let anf_app#6=(anon$2 ) + in + anf_app#6)))) + ) + (fun foo(a)-> + (let anf_app#7=(a ) + in + (let anf_app#8=(print_int anf_app#7) + in + (let anf_()#9=(anf_app#8 ) + in + (let anf_app#10=(anon$1 ) + in + anf_app#10)))) + ) + (fun main()-> + (let anf_app#11=(foo 4 8 9) + in + (let anf_()#12=(anf_app#11 ) + in + 0)) + ) + $ dune exec anf_conv_test < manytests/typed/007order.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index 6d9871903..cff624ac2 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -1,67 +1,67 @@ - $ dune exec clos_conv_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - (let fac n=(let rec fack n f=if ((n<=1)) then (((f ) 1)) else (((fack ) (n-1) ((fun n f x->(x*((f ) n))) n f))) in ((fack ) n ((fun x->x) )))) - $ dune exec clos_conv_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*((fack ) (n-1)))) in ((fack ) n))) - $ dune exec clos_conv_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - (let f a=(let g a c d=(let h a c d e=(a*(c+(d*e))) in ((h a c d) 4)) in ((g a) 2 3))) - $ dune exec clos_conv_test << EOF - > let rec fac n = if n<=1 then 1 else n * fac (n-1) - > - > let main = - > let () = print_int (fac 4) in - > 0 - > EOF - (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) - (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) - $ dune exec clos_conv_test < manytests/typed/001fac.ml - (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) - (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) - $ dune exec clos_conv_test < manytests/typed/002fac.ml - (let rec fac_cps n k=if ((n=1)) then (((k ) 1)) else (((fac_cps ) (n-1) ((fun n k p->((k ) (p*n))) n k)))) - (let main=(let ()=((print_int ) ((fac_cps ) 4 ((fun print_int->print_int) ))) in 0)) - $ dune exec clos_conv_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/004manyargs.ml - (let wrap f=if ((1=1)) then (f) else (f)) - (let test3 a b c=(let a a=((print_int ) a) in (let b b=((print_int ) b) in (let c c=((print_int ) c) in 0)))) - (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) - (let main=(let temp0=((wrap ) test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let temp1 temp0=((print_int ) temp0) in (let temp2=((wrap ) test3 1 10 100) in 0)))) - $ dune exec clos_conv_test < manytests/typed/005fix.ml - (let rec fix f x=((f ) ((fix ) f) x)) - (let fac self n=if ((n<=1)) then (1) else ((n*((self ) (n-1))))) - (let main=(let ()=((print_int ) ((fix ) fac 6)) in 0)) - $ dune exec clos_conv_test < manytests/typed/006partial.ml - (let foo b=if (b) then (((fun foo->(foo+2)) )) else (((fun foo->(foo*10)) ))) - (let foo x=((foo ) true ((foo ) false ((foo ) true ((foo ) false x))))) - (let main=(let ()=((print_int ) ((foo ) 11)) in 0)) - $ dune exec clos_conv_test < manytests/typed/006partial2.ml - (let foo a b c=(let ()=((print_int ) a) in (let ()=((print_int ) b) in (let ()=((print_int ) c) in (a+(b*c)))))) - (let main=(let foo=((foo ) 1) in (let foo foo=((foo foo) 2) in (let foo foo=((foo foo) 3) in (let ()=((print_int ) foo) in 0))))) - $ dune exec clos_conv_test < manytests/typed/006partial3.ml - (let foo a=(let ()=((print_int ) a) in ((fun b->(let ()=((print_int ) b) in ((fun c->((print_int ) c)) ))) ))) - (let main=(let ()=((foo ) 4 8 9) in 0)) - $ dune exec clos_conv_test < manytests/typed/007order.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec clos_conv_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (let fac n=(let rec fack n f=if ((n<=1)) then (((f ) 1)) else (((fack ) (n-1) ((fun n f x->(x*((f ) n))) n f))) in ((fack ) n ((fun x->x) )))) + $ dune exec clos_conv_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*((fack ) (n-1)))) in ((fack ) n))) + $ dune exec clos_conv_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (let f a=(let g a c d=(let h a c d e=(a*(c+(d*e))) in ((h a c d) 4)) in ((g a) 2 3))) + $ dune exec clos_conv_test << EOF + > let rec fac n = if n<=1 then 1 else n * fac (n-1) + > + > let main = + > let () = print_int (fac 4) in + > 0 + > EOF + (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) + (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) + $ dune exec clos_conv_test < manytests/typed/001fac.ml + (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) + (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) + $ dune exec clos_conv_test < manytests/typed/002fac.ml + (let rec fac_cps n k=if ((n=1)) then (((k ) 1)) else (((fac_cps ) (n-1) ((fun n k p->((k ) (p*n))) n k)))) + (let main=(let ()=((print_int ) ((fac_cps ) 4 ((fun print_int->print_int) ))) in 0)) + $ dune exec clos_conv_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/004manyargs.ml + (let wrap f=if ((1=1)) then (f) else (f)) + (let test3 a b c=(let a a=((print_int ) a) in (let b b=((print_int ) b) in (let c c=((print_int ) c) in 0)))) + (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) + (let main=(let temp0=((wrap ) test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let temp1 temp0=((print_int ) temp0) in (let temp2=((wrap ) test3 1 10 100) in 0)))) + $ dune exec clos_conv_test < manytests/typed/005fix.ml + (let rec fix f x=((f ) ((fix ) f) x)) + (let fac self n=if ((n<=1)) then (1) else ((n*((self ) (n-1))))) + (let main=(let ()=((print_int ) ((fix ) fac 6)) in 0)) + $ dune exec clos_conv_test < manytests/typed/006partial.ml + (let foo b=if (b) then (((fun foo->(foo+2)) )) else (((fun foo->(foo*10)) ))) + (let foo x=((foo ) true ((foo ) false ((foo ) true ((foo ) false x))))) + (let main=(let ()=((print_int ) ((foo ) 11)) in 0)) + $ dune exec clos_conv_test < manytests/typed/006partial2.ml + (let foo a b c=(let ()=((print_int ) a) in (let ()=((print_int ) b) in (let ()=((print_int ) c) in (a+(b*c)))))) + (let main=(let foo=((foo ) 1) in (let foo foo=((foo foo) 2) in (let foo foo=((foo foo) 3) in (let ()=((print_int ) foo) in 0))))) + $ dune exec clos_conv_test < manytests/typed/006partial3.ml + (let foo a=(let ()=((print_int ) a) in ((fun b->(let ()=((print_int ) b) in ((fun c->((print_int ) c)) ))) ))) + (let main=(let ()=((foo ) 4 8 9) in 0)) + $ dune exec clos_conv_test < manytests/typed/007order.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/dune b/slarnML/test/dune index 07dca9771..f5585a9be 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -122,3 +122,24 @@ manytests/typed/008ascription.ml manytests/typed/015tuples.ml manytests/typed/016lists.ml)) + +(cram + (applies_to exec_test) + (deps + ../lib/riscv64/print.S + ../lib/riscv64/part_app.c + manytests/do_not_type/001.ml + manytests/do_not_type/002if.ml + manytests/do_not_type/003occurs.ml + manytests/typed/001fac.ml + manytests/typed/002fac.ml + manytests/typed/003fib.ml + manytests/typed/004manyargs.ml + manytests/typed/005fix.ml + manytests/typed/006partial.ml + manytests/typed/006partial2.ml + manytests/typed/006partial3.ml + manytests/typed/007order.ml + manytests/typed/008ascription.ml + manytests/typed/015tuples.ml + manytests/typed/016lists.ml)) diff --git a/slarnML/test/exec_test.t b/slarnML/test/exec_test.t new file mode 100644 index 0000000000000000000000000000000000000000..de4a632606d0355e328b04073feffc018fb44105 GIT binary patch literal 4185 zcmeH~KX2PG5XCze=y!O70Vjhb{|SOdjRSN@r=l4=bO;KUCQk|hid0D|jlX?KOG+K5 zNSzkwkV=Daq^PI6$DdC!FoI|_f$oUIO2=sf2|9GOq?0Pkw79bcG=N!o;6zfRi2gOohOX?OcEt^ zbC;C5Nti=YG0SfjHl$ecZaESYqN+{}W*5i=-DbK`s(n&d&r>RCnkl)?x|P{B{d5^s z+t7q^f2&$@zL#8bHAA9}^CGCX5wpIKib5GhVJW!Dw2-<)!m*!3Sh`|$od(sAM?X3! z6&1Wy{66{4njMXx$Wqhz$8~+9s!2K{kbFeeINKZZ)54H%-5~A((rl{~y`H>kj~HLS z{nFb1G+2Qky@^!0%x`KE*<>;;7*8wpfVP2`m&nWPq~&EvWkuREFO5dQ8s)bHP3LES z%FyheGPKtm+9sLfy>nEp6E|FVU<$;(0Bt;&@240->!Wwj z^gRX$Et#w*u_JRf&2ee1u{qqPS{sG0OdGwLjv*bGvc$v&f{Jke_P*RU}_($Lu-)lWAvw@a@mV;@T545~|T7Ce$88Mvz literal 0 HcmV?d00001 diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 4f4150adb..5d88558f8 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -1,85 +1,85 @@ - $ dune exec lambda_lifting_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - (fun anon$1(n f x)->((x*(f (n ))))) - (fun fack(n f)->(if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))))) - (fun anon$2(x)->(x)) - (fun fac(n)->(let fack = (if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))) in (fack (n ) (anon$2 ))))) - $ dune exec lambda_lifting_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - (fun fack(n)->(if ((n<1)) then (n) else ((n*(fack (n-1)))))) - (fun fac(n)->(let fack = (if ((n<1)) then (n) else ((n*(fack (n-1)))) in (fack (n ))))) - $ dune exec lambda_lifting_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) - (fun g(a c d)->(let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)))) - (fun f(a)->(let g = (let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)) in (g (a ) 2 3)))) - $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml - fac not exist - $ dune exec lambda_lifting_test < manytests/do_not_type/002if.ml - (fun main()->(if (true) then (1) else (false))) - $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml - f not exist - $ dune exec lambda_lifting_test < manytests/typed/001fac.ml - (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) - (fun main()->(let () = ((print_int (fac 4)) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/002fac.ml - (fun anon$1(n k p)->((k (p*n)))) - (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1 (n ) (k )))))) - (fun anon$1(print_int)->(print_int)) - (fun main()->(let () = ((print_int (fac_cps 4 (anon$1 ))) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml - (fun wrap(f)->(if ((1=1)) then ((f )) else ((f )))) - (fun a(a)->((print_int (a )))) - (fun b(b)->((print_int (b )))) - (fun c(c)->((print_int (c )))) - (fun test3(a b c)->(let a = ((print_int (a )) in let b = ((print_int (b )) in let c = ((print_int (c )) in 0))))) - (fun test10(a b c d e f g h i j)->(((((((((((a )+(b ))+(c ))+(d ))+(e ))+(f ))+(g ))+(h ))+(i ))+(j )))) - (fun temp0()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) - (fun temp1(temp0)->((print_int (temp0 )))) - (fun temp2()->((wrap (test3 ) 1 10 100))) - (fun main()->(let temp0 = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1 = ((print_int (temp0 )) in let temp2 = ((wrap (test3 ) 1 10 100) in 0))))) - $ dune exec lambda_lifting_test < manytests/typed/005fix.ml - (fun fix(f x)->((f (fix (f )) (x )))) - (fun fac(self n)->(if (((n )<=1)) then (1) else (((n )*(self ((n )-1)))))) - (fun main()->(let () = ((print_int (fix (fac ) 6)) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/006partial.ml - (fun anon$1(foo)->((foo+2))) - (fun anon$2(foo)->((foo*10))) - (fun foo(b)->(if ((b )) then ((anon$1 )) else ((anon$2 )))) - (fun foo(x)->((foo true (foo false (foo true (foo false (x ))))))) - (fun main()->(let () = ((print_int (foo 11)) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/006partial2.ml - (fun foo(a b c)->(let () = ((print_int (a )) in let () = ((print_int (b )) in let () = ((print_int (c )) in ((a )+((b )*(c )))))))) - (fun foo()->((foo 1))) - (fun foo(foo)->((foo (foo ) 2))) - (fun foo(foo)->((foo (foo ) 3))) - (fun main()->(let foo = ((foo 1) in let foo = ((foo (foo ) 2) in let foo = ((foo (foo ) 3) in let () = ((print_int (foo )) in 0)))))) - $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - (fun anon$2(c)->((print_int (c )))) - (fun anon$1(b)->(let () = ((print_int (b )) in (anon$2 )))) - (fun foo(a)->(let () = ((print_int (a )) in (anon$1 )))) - (fun main()->(let () = ((foo 4 8 9) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/007order.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec lambda_lifting_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (fun anon$1(n f x)->((x*(f (n ))))) + (fun fack(n f)->(if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))))) + (fun anon$2(x)->(x)) + (fun fac(n)->(let fack = (if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))) in (fack (n ) (anon$2 ))))) + $ dune exec lambda_lifting_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (fun fack(n)->(if ((n<1)) then (n) else ((n*(fack (n-1)))))) + (fun fac(n)->(let fack = (if ((n<1)) then (n) else ((n*(fack (n-1)))) in (fack (n ))))) + $ dune exec lambda_lifting_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) + (fun g(a c d)->(let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)))) + (fun f(a)->(let g = (let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)) in (g (a ) 2 3)))) + $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec lambda_lifting_test < manytests/do_not_type/002if.ml + (fun main()->(if (true) then (1) else (false))) + $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml + f not exist + $ dune exec lambda_lifting_test < manytests/typed/001fac.ml + (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) + (fun main()->(let () = ((print_int (fac 4)) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/002fac.ml + (fun anon$1(n k p)->((k (p*n)))) + (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1 (n ) (k )))))) + (fun anon$1(print_int)->(print_int)) + (fun main()->(let () = ((print_int (fac_cps 4 (anon$1 ))) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml + (fun wrap(f)->(if ((1=1)) then ((f )) else ((f )))) + (fun a(a)->((print_int (a )))) + (fun b(b)->((print_int (b )))) + (fun c(c)->((print_int (c )))) + (fun test3(a b c)->(let a = ((print_int (a )) in let b = ((print_int (b )) in let c = ((print_int (c )) in 0))))) + (fun test10(a b c d e f g h i j)->(((((((((((a )+(b ))+(c ))+(d ))+(e ))+(f ))+(g ))+(h ))+(i ))+(j )))) + (fun temp0()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) + (fun temp1(temp0)->((print_int (temp0 )))) + (fun temp2()->((wrap (test3 ) 1 10 100))) + (fun main()->(let temp0 = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1 = ((print_int (temp0 )) in let temp2 = ((wrap (test3 ) 1 10 100) in 0))))) + $ dune exec lambda_lifting_test < manytests/typed/005fix.ml + (fun fix(f x)->((f (fix (f )) (x )))) + (fun fac(self n)->(if (((n )<=1)) then (1) else (((n )*(self ((n )-1)))))) + (fun main()->(let () = ((print_int (fix (fac ) 6)) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/006partial.ml + (fun anon$1(foo)->((foo+2))) + (fun anon$2(foo)->((foo*10))) + (fun foo(b)->(if ((b )) then ((anon$1 )) else ((anon$2 )))) + (fun foo(x)->((foo true (foo false (foo true (foo false (x ))))))) + (fun main()->(let () = ((print_int (foo 11)) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/006partial2.ml + (fun foo(a b c)->(let () = ((print_int (a )) in let () = ((print_int (b )) in let () = ((print_int (c )) in ((a )+((b )*(c )))))))) + (fun foo()->((foo 1))) + (fun foo(foo)->((foo (foo ) 2))) + (fun foo(foo)->((foo (foo ) 3))) + (fun main()->(let foo = ((foo 1) in let foo = ((foo (foo ) 2) in let foo = ((foo (foo ) 3) in let () = ((print_int (foo )) in 0)))))) + $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml + (fun anon$2(c)->((print_int (c )))) + (fun anon$1(b)->(let () = ((print_int (b )) in (anon$2 )))) + (fun foo(a)->(let () = ((print_int (a )) in (anon$1 )))) + (fun main()->(let () = ((foo 4 8 9) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/007order.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 97be29e96..06fb800cd 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -1,136 +1,136 @@ - $ dune exec parser_test << EOF - > let a = 3 - > EOF - (let a=3) - $ dune exec parser_test << EOF - > let () = 0 - > EOF - (let ()=0) - $ dune exec parser_test << EOF - > (fun a -> b) - > EOF - (fun a->b) - $ dune exec parser_test << EOF - > let rec a = b in (c) - > EOF - (let rec a=b in c) - $ dune exec parser_test << EOF - > if a then b else c - > EOF - if (a) then (b) else (c) - $ dune exec parser_test << EOF - > let a = - > let b = 1 in - > let c = b in - > c - > EOF - (let a=(let b=1 in (let c=b in c))) - $ dune exec parser_test << EOF - > true && (a + (f false (g 3 y)) = 3 || 2) - > EOF - (true&&(((a+(f->false->(g->3->y)))=3)||2)) - $ dune exec parser_test << EOF - > (a b 2 1+3 * b d (-2) (r f)) + 3 - > EOF - Error: : end_of_input - $ dune exec parser_test << EOF - > a b c - > EOF - (a->b->c) - $ dune exec parser_test << EOF - > (a + (f 2 x (g 3*z y)) * 3) - > EOF - (a+((f->2->x->((g->3)*(z->y)))*3)) - $ dune exec parser_test << EOF - > (a + f 2 x (g 3*z y) * 3) - > EOF - (a+(f->2->x->(((g->3)*(z->y))*3))) - $ dune exec parser_test << EOF - > a + 2 <= b * 3 - > EOF - ((a+2)<=(b*3)) - $ dune exec parser_test << EOF - > a < 2 && b = 3 - > EOF - ((a<2)&&(b=3)) - $ dune exec parser_test << EOF - > ((a b 2 1 + 3 * b d (-2) (r f)) + 3) - > EOF - (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) - $ dune exec parser_test << EOF - > let fac n = - > let rec fack n f = - > if n <= 1 - > then f 1 - > else fack (n - 1) (fun x -> x * f n) - > in - > fack n (fun x -> x) - > ;; - > EOF - (let fac n=(let rec fack n f=if ((n<=1)) then ((f->1)) else ((fack->(n-1)->(fun x->(x*(f->n))))) in (fack->n->(fun x->x)))) - $ dune exec parser_test << EOF - > let fac n = - > let rec fack n = if n < 1 then n else n * fack (n - 1) in - > fack n - > ;; - > EOF - (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*(fack->(n-1)))) in (fack->n))) - $ dune exec parser_test << EOF - > let x = fack n - > ;; - > EOF - (let x=(fack->n)) - $ dune exec parser_test << EOF - > f 1 + f 2 - > EOF - ((f->1)+(f->2)) - $ dune exec parser_test << EOF - > let rec fib n = - > if n<2 - > then n - > else (fib (n - 1) + fib (n - 2)) - > EOF - (let rec fib n=if ((n<2)) then (n) else ((fib->((n-1)+(fib->(n-2)))))) - $ dune exec parser_test < manytests/do_not_type/001.ml - (let recfac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) - $ dune exec parser_test < manytests/do_not_type/002if.ml - (let main=if (true) then (1) else (false)) - $ dune exec parser_test < manytests/do_not_type/003occurs.ml - (let fix f=(fun x->(f->(fun f->(x->x->f))))) - (fun x->(f->(fun f->(x->x->f)))) - $ dune exec parser_test < manytests/typed/001fac.ml - (let rec fac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) - (let main=(let ()=(print_int->(fac->4)) in 0)) - $ dune exec parser_test < manytests/typed/002fac.ml - (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))))) - (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) - $ dune exec parser_test < manytests/typed/003fib.ml - Error: : end_of_input - $ dune exec parser_test < manytests/typed/004manyargs.ml - (let wrap f=if ((1=1)) then (f) else (f)) - (let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0)))) - (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) - (let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0)))) - $ dune exec parser_test < manytests/typed/005fix.ml - (let rec fix f x=(f->(fix->f)->x)) - (let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1))))) - (let main=(let ()=(print_int->(fix->fac->6)) in 0)) - $ dune exec parser_test < manytests/typed/006partial.ml - (let foo b=if (b) then ((fun foo->(foo+2))) else ((fun foo->(foo*10)))) - (let foo x=(foo->true->(foo->false->(foo->true->(foo->false->x))))) - (let main=(let ()=(print_int->(foo->11)) in 0)) - $ dune exec parser_test < manytests/typed/006partial2.ml - (let foo a b c=(let ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(print_int->c) in (a+(b*c)))))) - (let main=(let foo=(foo->1) in (let foo=(foo->2) in (let foo=(foo->3) in (let ()=(print_int->foo) in 0))))) - $ dune exec parser_test < manytests/typed/006partial3.ml - (let foo a=(let ()=(print_int->a) in (fun b->(let ()=(print_int->b) in (fun c->(print_int->c)))))) - (let main=(let ()=(foo->4->8->9) in 0)) - $ dune exec parser_test < manytests/typed/007order.ml - Error: : end_of_input - $ dune exec parser_test < manytests/typed/008ascription.ml - Error: : end_of_input - $ dune exec parser_test < manytests/typed/015tuples.ml - Error: : end_of_input - $ dune exec parser_test < manytests/typed/016lists.ml - Error: : end_of_input - + $ dune exec parser_test << EOF + > let a = 3 + > EOF + (let a=3) + $ dune exec parser_test << EOF + > let () = 0 + > EOF + (let ()=0) + $ dune exec parser_test << EOF + > (fun a -> b) + > EOF + (fun a->b) + $ dune exec parser_test << EOF + > let rec a = b in (c) + > EOF + (let rec a=b in c) + $ dune exec parser_test << EOF + > if a then b else c + > EOF + if (a) then (b) else (c) + $ dune exec parser_test << EOF + > let a = + > let b = 1 in + > let c = b in + > c + > EOF + (let a=(let b=1 in (let c=b in c))) + $ dune exec parser_test << EOF + > true && (a + (f false (g 3 y)) = 3 || 2) + > EOF + (true&&(((a+(f->false->(g->3->y)))=3)||2)) + $ dune exec parser_test << EOF + > (a b 2 1+3 * b d (-2) (r f)) + 3 + > EOF + Error: : end_of_input + $ dune exec parser_test << EOF + > a b c + > EOF + (a->b->c) + $ dune exec parser_test << EOF + > (a + (f 2 x (g 3*z y)) * 3) + > EOF + (a+((f->2->x->((g->3)*(z->y)))*3)) + $ dune exec parser_test << EOF + > (a + f 2 x (g 3*z y) * 3) + > EOF + (a+(f->2->x->(((g->3)*(z->y))*3))) + $ dune exec parser_test << EOF + > a + 2 <= b * 3 + > EOF + ((a+2)<=(b*3)) + $ dune exec parser_test << EOF + > a < 2 && b = 3 + > EOF + ((a<2)&&(b=3)) + $ dune exec parser_test << EOF + > ((a b 2 1 + 3 * b d (-2) (r f)) + 3) + > EOF + (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) + $ dune exec parser_test << EOF + > let fac n = + > let rec fack n f = + > if n <= 1 + > then f 1 + > else fack (n - 1) (fun x -> x * f n) + > in + > fack n (fun x -> x) + > ;; + > EOF + (let fac n=(let rec fack n f=if ((n<=1)) then ((f->1)) else ((fack->(n-1)->(fun x->(x*(f->n))))) in (fack->n->(fun x->x)))) + $ dune exec parser_test << EOF + > let fac n = + > let rec fack n = if n < 1 then n else n * fack (n - 1) in + > fack n + > ;; + > EOF + (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*(fack->(n-1)))) in (fack->n))) + $ dune exec parser_test << EOF + > let x = fack n + > ;; + > EOF + (let x=(fack->n)) + $ dune exec parser_test << EOF + > f 1 + f 2 + > EOF + ((f->1)+(f->2)) + $ dune exec parser_test << EOF + > let rec fib n = + > if n<2 + > then n + > else (fib (n - 1) + fib (n - 2)) + > EOF + (let rec fib n=if ((n<2)) then (n) else ((fib->((n-1)+(fib->(n-2)))))) + $ dune exec parser_test < test/manytests/do_not_type/001.ml + (let recfac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) + $ dune exec parser_test < test/manytests/do_not_type/002if.ml + (let main=if (true) then (1) else (false)) + $ dune exec parser_test < test/manytests/do_not_type/003occurs.ml + (let fix f=(fun x->(f->(fun f->(x->x->f))))) + (fun x->(f->(fun f->(x->x->f)))) + $ dune exec parser_test < test/manytests/typed/001fac.ml + (let rec fac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) + (let main=(let ()=(print_int->(fac->4)) in 0)) + $ dune exec parser_test < test/manytests/typed/002fac.ml + (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))))) + (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) + $ dune exec parser_test < test/manytests/typed/003fib.ml + Error: : end_of_input + $ dune exec parser_test < test/manytests/typed/004manyargs.ml + (let wrap f=if ((1=1)) then (f) else (f)) + (let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0)))) + (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) + (let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0)))) + $ dune exec parser_test < test/manytests/typed/005fix.ml + (let rec fix f x=(f->(fix->f)->x)) + (let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1))))) + (let main=(let ()=(print_int->(fix->fac->6)) in 0)) + $ dune exec parser_test < test/manytests/typed/006partial.ml + (let foo b=if (b) then ((fun foo->(foo+2))) else ((fun foo->(foo*10)))) + (let foo x=(foo->true->(foo->false->(foo->true->(foo->false->x))))) + (let main=(let ()=(print_int->(foo->11)) in 0)) + $ dune exec parser_test < test/manytests/typed/006partial2.ml + (let foo a b c=(let ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(print_int->c) in (a+(b*c)))))) + (let main=(let foo=(foo->1) in (let foo=(foo->2) in (let foo=(foo->3) in (let ()=(print_int->foo) in 0))))) + $ dune exec parser_test < test/manytests/typed/006partial3.ml + (let foo a=(let ()=(print_int->a) in (fun b->(let ()=(print_int->b) in (fun c->(print_int->c)))))) + (let main=(let ()=(foo->4->8->9) in 0)) + $ dune exec parser_test < test/manytests/typed/007order.ml + Error: : end_of_input + $ dune exec parser_test < test/manytests/typed/008ascription.ml + Error: : end_of_input + $ dune exec parser_test < test/manytests/typed/015tuples.ml + Error: : end_of_input + $ dune exec parser_test < test/manytests/typed/016lists.ml + Error: : end_of_input + diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index a5ecfd576..cd44e72f8 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -1,1488 +1,1488 @@ - $ dune exec riscv64_instr_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - f not found - $ dune exec riscv64_instr_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - fack: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - li t0,1 - blt t0,a0,.tag_anf_op_1 - j .tag_anf_op_1_t - .tag_anf_op_1: - li t1,1 - sub t2,a0,t1 - sd t2,-24(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - ld t2,-88(s0) - mul t1,t2,a0 - sd a0,-32(s0) - mv a0,t1 - .tag_anf_op_1_t: - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - fac: - addi sp,sp,-192 - sd ra,176(sp) - sd s0,168(sp) - addi s0,sp,192 - sd a0,-184(s0) - li t0,1 - blt t0,a0,.tag_anf_op_6 - j .tag_anf_op_6_t - .tag_anf_op_6: - li t1,1 - sub t2,a0,t1 - sd t2,-24(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - ld t2,-184(s0) - mul t1,t2,a0 - sd a0,-32(s0) - mv a0,t1 - .tag_anf_op_6_t: - sd t1,-40(s0) - sd a0,-48(s0) - ld a0,-48(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-56(s0) - ld a0,-184(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-64(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,176(sp) - ld s0,168(sp) - addi sp,sp,192 - ret - $ dune exec riscv64_instr_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - e not found - $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml - fac not exist - $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - addi s0,sp,32 - li t0,1 - beqz t0,.tag_if_bnch - li t1,1 - mv a0,t1 - j .tag_if_bnch_t - .tag_if_bnch: - li t2,0 - mv a0,t2 - .tag_if_bnch_t: - mv a0,a0 - ld ra,16(sp) - ld s0,8(sp) - addi sp,sp,32 - ret - $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml - f not exist - $ dune exec riscv64_instr_test < manytests/typed/001fac.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - fac: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - li t0,1 - ble t0,a0,.tag_anf_op_1 - li t1,1 - mv a0,t1 - j .tag_anf_op_1_t - .tag_anf_op_1: - ld a0,-88(s0) - li t2,1 - sub t3,a0,t2 - sd t3,-24(s0) - lui a0,%hi(fac) - addi a0,a0,%lo(fac) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - ld t3,-88(s0) - mul t2,t3,a0 - sd a0,-32(s0) - mv a0,t2 - .tag_anf_op_1_t: - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - main: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 - lui a0,%hi(fac) - addi a0,a0,%lo(fac) - li a3,4 - li a2,1 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 - ret - $ dune exec riscv64_instr_test < manytests/typed/002fac.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_1: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 - sd a2,-80(s0) - sd a1,-72(s0) - sd a0,-64(s0) - mul t0,a2,a0 - sd t0,-24(s0) - ld a0,-72(s0) - ld a3,-24(s0) - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - fac_cps: - addi sp,sp,-224 - sd ra,208(sp) - sd s0,200(sp) - addi s0,sp,224 - sd a1,-216(s0) - sd a0,-208(s0) - li t0,1 - beq a0,t0,.tag_anf_op_3 - ld a0,-216(s0) - li a3,1 - li a2,1 - li a1,0 - call part_app - j .tag_anf_op_3_t - .tag_anf_op_3: - ld t0,-208(s0) - li a1,1 - sub t1,t0,a1 - sd a0,-24(s0) - sd t1,-32(s0) - ld a0,-208(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-216(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-48(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - ld a4,-48(s0) - ld a3,-40(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-56(s0) - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - ld a4,-56(s0) - ld a3,-32(s0) - li a2,2 - li a1,2 - call part_app - .tag_anf_op_3_t: - sd a0,-64(s0) - mv a0,a0 - ld ra,208(sp) - ld s0,200(sp) - addi sp,sp,224 - ret - anon_1: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - addi s0,sp,32 - sd a0,-24(s0) - mv a0,a0 - ld ra,16(sp) - ld s0,8(sp) - addi sp,sp,32 - ret - main: - addi sp,sp,-144 - sd ra,136(sp) - sd s0,128(sp) - addi s0,sp,144 - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - li a2,0 - li a1,3 - call part_app - sd a0,-24(s0) - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - ld a4,-24(s0) - li a3,4 - li a2,2 - li a1,2 - call part_app - sd a0,-32(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-32(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-40(s0) - ld a0,-40(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,136(sp) - ld s0,128(sp) - addi sp,sp,144 - ret - $ dune exec riscv64_instr_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - wrap: - addi sp,sp,-112 - sd ra,96(sp) - sd s0,88(sp) - addi s0,sp,112 - sd a0,-104(s0) - li t0,1 - li t1,1 - beq t0,t1,.tag_anf_op_1 - ld a0,-104(s0) - li a2,0 - li a1,0 - call part_app - j .tag_anf_op_1_t - .tag_anf_op_1: - sd a0,-24(s0) - ld a0,-104(s0) - li a2,0 - li a1,0 - call part_app - .tag_anf_op_1_t: - sd a0,-32(s0) - mv a0,a0 - ld ra,96(sp) - ld s0,88(sp) - addi sp,sp,112 - ret - a: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(a) - addi a0,a0,%lo(a) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - b: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(b) - addi a0,a0,%lo(b) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - c: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(c) - addi a0,a0,%lo(c) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - test3: - addi sp,sp,-336 - sd ra,320(sp) - sd s0,312(sp) - addi s0,sp,336 - sd a2,-328(s0) - sd a1,-320(s0) - sd a0,-312(s0) - lui a0,%hi(a) - addi a0,a0,%lo(a) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(b) - addi a0,a0,%lo(b) - li a2,0 - li a1,1 - call part_app - sd a0,-48(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-48(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-56(s0) - ld a0,-56(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - lui a0,%hi(c) - addi a0,a0,%lo(c) - li a2,0 - li a1,1 - call part_app - sd a0,-72(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-72(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-80(s0) - ld a0,-80(s0) - li a2,0 - li a1,0 - call part_app - li a1,0 - mv a0,a1 - ld ra,320(sp) - ld s0,312(sp) - addi sp,sp,336 - ret - test10: - addi sp,sp,-480 - sd ra,464(sp) - sd s0,456(sp) - addi s0,sp,480 - sd a7,-472(s0) - sd a6,-464(s0) - sd a5,-456(s0) - sd a4,-448(s0) - sd a3,-440(s0) - sd a2,-432(s0) - sd a1,-424(s0) - sd a0,-416(s0) - lui a0,%hi(a) - addi a0,a0,%lo(a) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(b) - addi a0,a0,%lo(b) - li a2,0 - li a1,1 - call part_app - ld a1,-24(s0) - add a2,a1,a0 - sd a0,-32(s0) - sd a2,-40(s0) - lui a0,%hi(c) - addi a0,a0,%lo(c) - li a2,0 - li a1,1 - call part_app - ld a2,-40(s0) - add a1,a2,a0 - sd a0,-48(s0) - sd a1,-56(s0) - ld a0,-440(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-56(s0) - add a2,a1,a0 - sd a0,-64(s0) - sd a2,-72(s0) - ld a0,-448(s0) - li a2,0 - li a1,0 - call part_app - ld a2,-72(s0) - add a1,a2,a0 - sd a0,-80(s0) - sd a1,-88(s0) - ld a0,-456(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-88(s0) - add a2,a1,a0 - sd a0,-96(s0) - sd a2,-104(s0) - ld a0,-464(s0) - li a2,0 - li a1,0 - call part_app - ld a2,-104(s0) - add a1,a2,a0 - sd a0,-112(s0) - sd a1,-120(s0) - ld a0,-472(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-120(s0) - add a2,a1,a0 - sd a0,-128(s0) - sd a2,-136(s0) - ld a0,0(s0) - li a2,0 - li a1,0 - call part_app - ld a2,-136(s0) - add a1,a2,a0 - sd a0,-144(s0) - sd a1,-152(s0) - ld a0,8(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-152(s0) - add a2,a1,a0 - mv a0,a2 - ld ra,464(sp) - ld s0,456(sp) - addi sp,sp,480 - ret - temp0: - addi sp,sp,-112 - sd ra,96(sp) - sd s0,88(sp) - addi s0,sp,112 - lui a0,%hi(test10) - addi a0,a0,%lo(test10) - li a2,0 - li a1,10 - call part_app - sd a0,-24(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li t6,10000 - sd t6,0(sp) - li t6,100000 - sd t6,8(sp) - li t6,1000000 - sd t6,16(sp) - li t6,10000000 - sd t6,24(sp) - li t6,100000000 - sd t6,32(sp) - li t6,1000000000 - sd t6,40(sp) - li a7,1000 - li a6,100 - li a5,10 - li a4,1 - ld a3,-24(s0) - li a2,11 - li a1,1 - call part_app - mv a0,a0 - ld ra,96(sp) - ld s0,88(sp) - addi sp,sp,112 - ret - temp1: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(temp0) - addi a0,a0,%lo(temp0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - temp2: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 - lui a0,%hi(test3) - addi a0,a0,%lo(test3) - li a2,0 - li a1,3 - call part_app - sd a0,-24(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li a6,100 - li a5,10 - li a4,1 - ld a3,-24(s0) - li a2,4 - li a1,1 - call part_app - mv a0,a0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - main: - addi sp,sp,-336 - sd ra,320(sp) - sd s0,312(sp) - addi s0,sp,336 - lui a0,%hi(test10) - addi a0,a0,%lo(test10) - li a2,0 - li a1,10 - call part_app - sd a0,-24(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li t6,10000 - sd t6,0(sp) - li t6,100000 - sd t6,8(sp) - li t6,1000000 - sd t6,16(sp) - li t6,10000000 - sd t6,24(sp) - li t6,100000000 - sd t6,32(sp) - li t6,1000000000 - sd t6,40(sp) - li a7,1000 - li a6,100 - li a5,10 - li a4,1 - ld a3,-24(s0) - li a2,11 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(temp0) - addi a0,a0,%lo(temp0) - li a2,0 - li a1,0 - call part_app - sd a0,-48(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-48(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-56(s0) - ld a0,-56(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - lui a0,%hi(test3) - addi a0,a0,%lo(test3) - li a2,0 - li a1,3 - call part_app - sd a0,-72(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li a6,100 - li a5,10 - li a4,1 - ld a3,-72(s0) - li a2,4 - li a1,1 - call part_app - sd a0,-80(s0) - ld a0,-80(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,320(sp) - ld s0,312(sp) - addi sp,sp,336 - ret - $ dune exec riscv64_instr_test < manytests/typed/005fix.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - fix: - addi sp,sp,-160 - sd ra,152(sp) - sd s0,144(sp) - addi s0,sp,160 - sd a1,-160(s0) - sd a0,-152(s0) - ld a0,-152(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(fix) - addi a0,a0,%lo(fix) - ld a3,-24(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-32(s0) - ld a0,-160(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-152(s0) - ld a4,-40(s0) - ld a3,-32(s0) - li a2,2 - li a1,0 - call part_app - mv a0,a0 - ld ra,152(sp) - ld s0,144(sp) - addi sp,sp,160 - ret - fac: - addi sp,sp,-192 - sd ra,184(sp) - sd s0,176(sp) - addi s0,sp,192 - sd a1,-192(s0) - sd a0,-184(s0) - ld a0,-192(s0) - li a2,0 - li a1,0 - call part_app - li a1,1 - ble a1,a0,.tag_anf_op_6 - li t0,1 - sd a0,-24(s0) - mv a0,t0 - j .tag_anf_op_6_t - .tag_anf_op_6: - ld a0,-192(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-32(s0) - ld a0,-192(s0) - li a2,0 - li a1,0 - call part_app - li t0,1 - sub a1,a0,t0 - sd a0,-40(s0) - sd a1,-48(s0) - ld a0,-184(s0) - ld a3,-48(s0) - li a2,1 - li a1,0 - call part_app - ld a1,-32(s0) - mul t0,a1,a0 - sd a0,-56(s0) - mv a0,t0 - .tag_anf_op_6_t: - mv a0,a0 - ld ra,184(sp) - ld s0,176(sp) - addi sp,sp,192 - ret - main: - addi sp,sp,-144 - sd ra,136(sp) - sd s0,128(sp) - addi s0,sp,144 - lui a0,%hi(fac) - addi a0,a0,%lo(fac) - li a2,0 - li a1,2 - call part_app - sd a0,-24(s0) - lui a0,%hi(fix) - addi a0,a0,%lo(fix) - li a4,6 - ld a3,-24(s0) - li a2,2 - li a1,2 - call part_app - sd a0,-32(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-32(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-40(s0) - ld a0,-40(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,136(sp) - ld s0,128(sp) - addi sp,sp,144 - ret - $ dune exec riscv64_instr_test < manytests/typed/006partial.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_1: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - sd a0,-32(s0) - li t0,2 - add t1,a0,t0 - mv a0,t1 - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 - ret - anon_2: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - sd a0,-32(s0) - li t0,10 - mul t1,a0,t0 - mv a0,t1 - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 - ret - foo: - addi sp,sp,-128 - sd ra,120(sp) - sd s0,112(sp) - addi s0,sp,128 - sd a0,-128(s0) - ld a0,-128(s0) - li a2,0 - li a1,0 - call part_app - beqz a0,.tag_if_bnch - sd a0,-24(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - li a2,0 - li a1,1 - call part_app - j .tag_if_bnch_t - .tag_if_bnch: - sd a0,-32(s0) - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - li a2,0 - li a1,1 - call part_app - .tag_if_bnch_t: - sd a0,-40(s0) - mv a0,a0 - ld ra,120(sp) - ld s0,112(sp) - addi sp,sp,128 - ret - foo: - addi sp,sp,-192 - sd ra,176(sp) - sd s0,168(sp) - addi s0,sp,192 - sd a0,-184(s0) - ld a0,-184(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-24(s0) - li a3,0 - li a2,2 - li a1,1 - call part_app - sd a0,-32(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-32(s0) - li a3,1 - li a2,2 - li a1,1 - call part_app - sd a0,-40(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-40(s0) - li a3,0 - li a2,2 - li a1,1 - call part_app - sd a0,-48(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-48(s0) - li a3,1 - li a2,2 - li a1,1 - call part_app - mv a0,a0 - ld ra,176(sp) - ld s0,168(sp) - addi sp,sp,192 - ret - main: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,11 - li a2,1 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 - ret - $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - foo: - addi sp,sp,-448 - sd ra,432(sp) - sd s0,424(sp) - addi s0,sp,448 - sd a2,-440(s0) - sd a1,-432(s0) - sd a0,-424(s0) - ld a0,-424(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-432(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-48(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-48(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-56(s0) - ld a0,-56(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - ld a0,-440(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-72(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-72(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-80(s0) - ld a0,-80(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-88(s0) - ld a0,-424(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-96(s0) - ld a0,-432(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-104(s0) - ld a0,-440(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-104(s0) - mul a2,a1,a0 - ld t0,-96(s0) - add t1,t0,a2 - mv a0,t1 - ld ra,432(sp) - ld s0,424(sp) - addi sp,sp,448 - ret - foo: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,1 - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,40(sp) - ld s0,32(sp) - addi sp,sp,48 - ret - foo: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,2 - ld a3,-24(s0) - li a2,2 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - foo: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,3 - ld a3,-24(s0) - li a2,2 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - main: - addi sp,sp,-368 - sd ra,360(sp) - sd s0,352(sp) - addi s0,sp,368 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,1 - li a2,1 - li a1,3 - call part_app - sd a0,-24(s0) - ld a0,-24(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-32(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,3 - call part_app - sd a0,-40(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,2 - ld a3,-40(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-48(s0) - ld a0,-48(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-56(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,3 - call part_app - sd a0,-64(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,3 - ld a3,-64(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-72(s0) - ld a0,-72(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-80(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,3 - call part_app - sd a0,-88(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-88(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-96(s0) - ld a0,-96(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,360(sp) - ld s0,352(sp) - addi sp,sp,368 - ret - $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_2: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - ld a0,-88(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - anon_1: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a0,-152(s0) - ld a0,-152(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - li a2,0 - li a1,1 - call part_app - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - foo: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a0,-152(s0) - ld a0,-152(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - li a2,0 - li a1,1 - call part_app - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - main: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a5,9 - li a4,8 - li a3,4 - li a2,3 - li a1,1 - call part_app - sd a0,-24(s0) - ld a0,-24(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - $ dune exec riscv64_instr_test < manytests/typed/007order.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec riscv64_instr_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + f not found + $ dune exec riscv64_instr_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fack: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + li t0,1 + blt t0,a0,.tag_anf_op_1 + j .tag_anf_op_1_t + .tag_anf_op_1: + li t1,1 + sub t2,a0,t1 + sd t2,-24(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t2,-88(s0) + mul t1,t2,a0 + sd a0,-32(s0) + mv a0,t1 + .tag_anf_op_1_t: + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + fac: + addi sp,sp,-192 + sd ra,176(sp) + sd s0,168(sp) + addi s0,sp,192 + sd a0,-184(s0) + li t0,1 + blt t0,a0,.tag_anf_op_6 + j .tag_anf_op_6_t + .tag_anf_op_6: + li t1,1 + sub t2,a0,t1 + sd t2,-24(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t2,-184(s0) + mul t1,t2,a0 + sd a0,-32(s0) + mv a0,t1 + .tag_anf_op_6_t: + sd t1,-40(s0) + sd a0,-48(s0) + ld a0,-48(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-56(s0) + ld a0,-184(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-64(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 + ret + $ dune exec riscv64_instr_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + e not found + $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + addi s0,sp,32 + li t0,1 + beqz t0,.tag_if_bnch + li t1,1 + mv a0,t1 + j .tag_if_bnch_t + .tag_if_bnch: + li t2,0 + mv a0,t2 + .tag_if_bnch_t: + mv a0,a0 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 + ret + $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml + f not exist + $ dune exec riscv64_instr_test < manytests/typed/001fac.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fac: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + li t0,1 + ble t0,a0,.tag_anf_op_1 + li t1,1 + mv a0,t1 + j .tag_anf_op_1_t + .tag_anf_op_1: + ld a0,-88(s0) + li t2,1 + sub t3,a0,t2 + sd t3,-24(s0) + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t3,-88(s0) + mul t2,t3,a0 + sd a0,-32(s0) + mv a0,t2 + .tag_anf_op_1_t: + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a3,4 + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + $ dune exec riscv64_instr_test < manytests/typed/002fac.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) + mul t0,a2,a0 + sd t0,-24(s0) + ld a0,-72(s0) + ld a3,-24(s0) + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + fac_cps: + addi sp,sp,-224 + sd ra,208(sp) + sd s0,200(sp) + addi s0,sp,224 + sd a1,-216(s0) + sd a0,-208(s0) + li t0,1 + beq a0,t0,.tag_anf_op_3 + ld a0,-216(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + j .tag_anf_op_3_t + .tag_anf_op_3: + ld t0,-208(s0) + li a1,1 + sub t1,t0,a1 + sd a0,-24(s0) + sd t1,-32(s0) + ld a0,-208(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-216(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a4,-48(s0) + ld a3,-40(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-56(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-56(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + .tag_anf_op_3_t: + sd a0,-64(s0) + mv a0,a0 + ld ra,208(sp) + ld s0,200(sp) + addi sp,sp,224 + ret + anon_1: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + addi s0,sp,32 + sd a0,-24(s0) + mv a0,a0 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 + ret + main: + addi sp,sp,-144 + sd ra,136(sp) + sd s0,128(sp) + addi s0,sp,144 + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + li a2,0 + li a1,3 + call part_app + sd a0,-24(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-24(s0) + li a3,4 + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,136(sp) + ld s0,128(sp) + addi sp,sp,144 + ret + $ dune exec riscv64_instr_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + wrap: + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + sd a0,-104(s0) + li t0,1 + li t1,1 + beq t0,t1,.tag_anf_op_1 + ld a0,-104(s0) + li a2,0 + li a1,0 + call part_app + j .tag_anf_op_1_t + .tag_anf_op_1: + sd a0,-24(s0) + ld a0,-104(s0) + li a2,0 + li a1,0 + call part_app + .tag_anf_op_1_t: + sd a0,-32(s0) + mv a0,a0 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 + ret + a: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + b: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + c: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + test3: + addi sp,sp,-336 + sd ra,320(sp) + sd s0,312(sp) + addi s0,sp,336 + sd a2,-328(s0) + sd a1,-320(s0) + sd a0,-312(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 + li a1,1 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + sd a0,-72(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-72(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + li a1,0 + mv a0,a1 + ld ra,320(sp) + ld s0,312(sp) + addi sp,sp,336 + ret + test10: + addi sp,sp,-480 + sd ra,464(sp) + sd s0,456(sp) + addi s0,sp,480 + sd a7,-472(s0) + sd a6,-464(s0) + sd a5,-456(s0) + sd a4,-448(s0) + sd a3,-440(s0) + sd a2,-432(s0) + sd a1,-424(s0) + sd a0,-416(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 + li a1,1 + call part_app + ld a1,-24(s0) + add a2,a1,a0 + sd a0,-32(s0) + sd a2,-40(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + ld a2,-40(s0) + add a1,a2,a0 + sd a0,-48(s0) + sd a1,-56(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-56(s0) + add a2,a1,a0 + sd a0,-64(s0) + sd a2,-72(s0) + ld a0,-448(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-72(s0) + add a1,a2,a0 + sd a0,-80(s0) + sd a1,-88(s0) + ld a0,-456(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-88(s0) + add a2,a1,a0 + sd a0,-96(s0) + sd a2,-104(s0) + ld a0,-464(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-104(s0) + add a1,a2,a0 + sd a0,-112(s0) + sd a1,-120(s0) + ld a0,-472(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-120(s0) + add a2,a1,a0 + sd a0,-128(s0) + sd a2,-136(s0) + ld a0,0(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-136(s0) + add a1,a2,a0 + sd a0,-144(s0) + sd a1,-152(s0) + ld a0,8(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-152(s0) + add a2,a1,a0 + mv a0,a2 + ld ra,464(sp) + ld s0,456(sp) + addi sp,sp,480 + ret + temp0: + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + lui a0,%hi(test10) + addi a0,a0,%lo(test10) + li a2,0 + li a1,10 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li t6,10000 + sd t6,0(sp) + li t6,100000 + sd t6,8(sp) + li t6,1000000 + sd t6,16(sp) + li t6,10000000 + sd t6,24(sp) + li t6,100000000 + sd t6,32(sp) + li t6,1000000000 + sd t6,40(sp) + li a7,1000 + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,11 + li a1,1 + call part_app + mv a0,a0 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 + ret + temp1: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(temp0) + addi a0,a0,%lo(temp0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + temp2: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a2,0 + li a1,3 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,4 + li a1,1 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + main: + addi sp,sp,-336 + sd ra,320(sp) + sd s0,312(sp) + addi s0,sp,336 + lui a0,%hi(test10) + addi a0,a0,%lo(test10) + li a2,0 + li a1,10 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li t6,10000 + sd t6,0(sp) + li t6,100000 + sd t6,8(sp) + li t6,1000000 + sd t6,16(sp) + li t6,10000000 + sd t6,24(sp) + li t6,100000000 + sd t6,32(sp) + li t6,1000000000 + sd t6,40(sp) + li a7,1000 + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,11 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(temp0) + addi a0,a0,%lo(temp0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a2,0 + li a1,3 + call part_app + sd a0,-72(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li a6,100 + li a5,10 + li a4,1 + ld a3,-72(s0) + li a2,4 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,320(sp) + ld s0,312(sp) + addi sp,sp,336 + ret + $ dune exec riscv64_instr_test < manytests/typed/005fix.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fix: + addi sp,sp,-160 + sd ra,152(sp) + sd s0,144(sp) + addi s0,sp,160 + sd a1,-160(s0) + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + ld a3,-24(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + ld a0,-160(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-152(s0) + ld a4,-40(s0) + ld a3,-32(s0) + li a2,2 + li a1,0 + call part_app + mv a0,a0 + ld ra,152(sp) + ld s0,144(sp) + addi sp,sp,160 + ret + fac: + addi sp,sp,-192 + sd ra,184(sp) + sd s0,176(sp) + addi s0,sp,192 + sd a1,-192(s0) + sd a0,-184(s0) + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + li a1,1 + ble a1,a0,.tag_anf_op_6 + li t0,1 + sd a0,-24(s0) + mv a0,t0 + j .tag_anf_op_6_t + .tag_anf_op_6: + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + li t0,1 + sub a1,a0,t0 + sd a0,-40(s0) + sd a1,-48(s0) + ld a0,-184(s0) + ld a3,-48(s0) + li a2,1 + li a1,0 + call part_app + ld a1,-32(s0) + mul t0,a1,a0 + sd a0,-56(s0) + mv a0,t0 + .tag_anf_op_6_t: + mv a0,a0 + ld ra,184(sp) + ld s0,176(sp) + addi sp,sp,192 + ret + main: + addi sp,sp,-144 + sd ra,136(sp) + sd s0,128(sp) + addi s0,sp,144 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a2,0 + li a1,2 + call part_app + sd a0,-24(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + li a4,6 + ld a3,-24(s0) + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,136(sp) + ld s0,128(sp) + addi sp,sp,144 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,2 + add t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + anon_2: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,10 + mul t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + foo: + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a0,-128(s0) + ld a0,-128(s0) + li a2,0 + li a1,0 + call part_app + beqz a0,.tag_if_bnch + sd a0,-24(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + li a2,0 + li a1,1 + call part_app + j .tag_if_bnch_t + .tag_if_bnch: + sd a0,-32(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + li a2,0 + li a1,1 + call part_app + .tag_if_bnch_t: + sd a0,-40(s0) + mv a0,a0 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 + ret + foo: + addi sp,sp,-192 + sd ra,176(sp) + sd s0,168(sp) + addi s0,sp,192 + sd a0,-184(s0) + ld a0,-184(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-24(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-32(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-32(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + sd a0,-40(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-40(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-48(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-48(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 + ret + main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,11 + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + foo: + addi sp,sp,-448 + sd ra,432(sp) + sd s0,424(sp) + addi s0,sp,448 + sd a2,-440(s0) + sd a1,-432(s0) + sd a0,-424(s0) + ld a0,-424(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-432(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-72(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-72(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-88(s0) + ld a0,-424(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-96(s0) + ld a0,-432(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-104(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-104(s0) + mul a2,a1,a0 + ld t0,-96(s0) + add t1,t0,a2 + mv a0,t1 + ld ra,432(sp) + ld s0,424(sp) + addi sp,sp,448 + ret + foo: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,1 + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret + foo: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,2 + ld a3,-24(s0) + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + foo: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,3 + ld a3,-24(s0) + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + main: + addi sp,sp,-368 + sd ra,360(sp) + sd s0,352(sp) + addi s0,sp,368 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,1 + li a2,1 + li a1,3 + call part_app + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-40(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,2 + ld a3,-40(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-56(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-64(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,3 + ld a3,-64(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-72(s0) + ld a0,-72(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-80(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-88(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-88(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-96(s0) + ld a0,-96(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,360(sp) + ld s0,352(sp) + addi sp,sp,368 + ret + $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_2: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + ld a0,-88(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + anon_1: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + li a2,0 + li a1,1 + call part_app + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + foo: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + li a2,0 + li a1,1 + call part_app + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + main: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a5,9 + li a4,8 + li a3,4 + li a2,3 + li a1,1 + call part_app + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + $ dune exec riscv64_instr_test < manytests/typed/007order.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec riscv64_instr_test < manytests/typed/016lists.ml + : end_of_input From e01b2c6d3faadec4e6507aee1069a7295ed629d8 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Fri, 21 Mar 2025 07:59:01 +0300 Subject: [PATCH 20/24] Fix unix fmt --- slarnML/.gitignore | 14 +- slarnML/.ocamlformat | 4 +- slarnML/Makefile | 46 +- slarnML/demo/.gdb_history | 170 +- slarnML/demo/.gdbinit | 44 +- slarnML/dune-project | 66 +- slarnML/lib/riscv64/.gdbinit | 26 +- slarnML/lib/riscv64/part_app.c | 244 +- slarnML/lib/riscv64/print.S | 172 +- slarnML/lib/riscv64/riscv.ml | 88 +- slarnML/test/anf_conv_test.t | 1294 ++++----- slarnML/test/clos_conv_test.t | 135 +- slarnML/test/dune | 40 +- slarnML/test/{exec_test.t => exec_test.t_} | Bin slarnML/test/lambda_lifting_test.t | 170 +- slarnML/test/parser_tests.t | 272 +- slarnML/test/riscv64_instr_test.t | 2991 ++++++++++---------- 17 files changed, 2896 insertions(+), 2880 deletions(-) rename slarnML/test/{exec_test.t => exec_test.t_} (100%) diff --git a/slarnML/.gitignore b/slarnML/.gitignore index 866f5db56..9be1d8541 100644 --- a/slarnML/.gitignore +++ b/slarnML/.gitignore @@ -1,7 +1,7 @@ -.vscode -_build -trash - -*.o -*.out -demo/main.S +.vscode +_build +trash + +*.o +*.out +demo/main.S diff --git a/slarnML/.ocamlformat b/slarnML/.ocamlformat index 2555c2d10..b0368510d 100644 --- a/slarnML/.ocamlformat +++ b/slarnML/.ocamlformat @@ -1,3 +1,3 @@ -profile=janestreet -sequence-style=terminator +profile=janestreet +sequence-style=terminator max-indent=2 \ No newline at end of file diff --git a/slarnML/Makefile b/slarnML/Makefile index 04a45d884..3c10647e9 100644 --- a/slarnML/Makefile +++ b/slarnML/Makefile @@ -1,23 +1,23 @@ -.PHONY: repl tests test fmt lint celan - -all: - dune build - -repl: - dune build ./slarn.exe && rlwrap _build/default/slarn.exe - -test: - dune runtest - -clean: - @$(RM) -r _build - -fmt: - dune build @fmt --auto-promote - -lint: - dune build @lint --force - -release: - dune build --profile=release - dune runtest --profile=release +.PHONY: repl tests test fmt lint celan + +all: + dune build + +repl: + dune build ./slarn.exe && rlwrap _build/default/slarn.exe + +test: + dune runtest + +clean: + @$(RM) -r _build + +fmt: + dune build @fmt --auto-promote + +lint: + dune build @lint --force + +release: + dune build --profile=release + dune runtest --profile=release diff --git a/slarnML/demo/.gdb_history b/slarnML/demo/.gdb_history index 8ac184012..8460b87e4 100644 --- a/slarnML/demo/.gdb_history +++ b/slarnML/demo/.gdb_history @@ -1,85 +1,85 @@ -b _start -c -ni -ni -ni -ni -ni -exit -c -b main -c -b fac -c -b fac_fack -b fack_fack -b fack_fac -c -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -exit -b fac_fack -b fack_fac -c -c -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -ni -exit +b _start +c +ni +ni +ni +ni +ni +exit +c +b main +c +b fac +c +b fac_fack +b fack_fack +b fack_fac +c +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +exit +b fac_fack +b fack_fac +c +c +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +ni +exit diff --git a/slarnML/demo/.gdbinit b/slarnML/demo/.gdbinit index 56b06ac3f..0942d8c4e 100644 --- a/slarnML/demo/.gdbinit +++ b/slarnML/demo/.gdbinit @@ -1,23 +1,23 @@ -set history save -set architecture riscv:rv64 -set sysroot /usr/riscv64−linux−gnu -target remote :1234 -tui enable -tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 -layout example -# tui disable -focus cmd -b _start -b .breakpoint0 -b .breakpoint1 -b .breakpoint2 -b .breakpoint3 -b .breakpoint4 -b .breakpoint5 -b .breakpoint6 -b .breakpoint7 -b .breakpoint8 -b .breakpoint9 -b print_int -# c +set history save +set architecture riscv:rv64 +set sysroot /usr/riscv64−linux−gnu +target remote :1234 +tui enable +tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 +layout example +# tui disable +focus cmd +b _start +b .breakpoint0 +b .breakpoint1 +b .breakpoint2 +b .breakpoint3 +b .breakpoint4 +b .breakpoint5 +b .breakpoint6 +b .breakpoint7 +b .breakpoint8 +b .breakpoint9 +b print_int +# c # x/8xg $sp \ No newline at end of file diff --git a/slarnML/dune-project b/slarnML/dune-project index c4e4b8d49..bc6dc6ea5 100644 --- a/slarnML/dune-project +++ b/slarnML/dune-project @@ -1,33 +1,33 @@ -(lang dune 2.9) - -(name slarnML) - -(generate_opam_files true) - -(cram enable) - -(license LGPL-3.0-or-later) - -(source - (github ioannessh/comp24)) - -(authors "Ivan Shurenkov") - -(maintainers "Ivan Shurenkov") - -(package - (name slarnML) - (synopsis "SlarnML") - (version 0.0) - (depends - ocaml - dune - angstrom - base - (ppx_inline_test :with-test) - ppx_expect - ppx_deriving - bisect_ppx - (odoc :with-doc) - (ocamlformat :build))) - +(lang dune 2.9) + +(name slarnML) + +(generate_opam_files true) + +(cram enable) + +(license LGPL-3.0-or-later) + +(source + (github ioannessh/comp24)) + +(authors "Ivan Shurenkov") + +(maintainers "Ivan Shurenkov") + +(package + (name slarnML) + (synopsis "SlarnML") + (version 0.0) + (depends + ocaml + dune + angstrom + base + (ppx_inline_test :with-test) + ppx_expect + ppx_deriving + bisect_ppx + (odoc :with-doc) + (ocamlformat :build))) + diff --git a/slarnML/lib/riscv64/.gdbinit b/slarnML/lib/riscv64/.gdbinit index b7c4879a8..98b540775 100644 --- a/slarnML/lib/riscv64/.gdbinit +++ b/slarnML/lib/riscv64/.gdbinit @@ -1,14 +1,14 @@ -set history save -set architecture riscv:rv64 -set sysroot /usr/riscv64−linux−gnu -target remote :1234 -tui enable -# tui new−layout example {−horizontal regs 1 asm 1} 2 status -# cmd 1 -tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 -layout example -# tui disable -focus cmd -b _start -c +set history save +set architecture riscv:rv64 +set sysroot /usr/riscv64−linux−gnu +target remote :1234 +tui enable +# tui new−layout example {−horizontal regs 1 asm 1} 2 status +# cmd 1 +tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1 +layout example +# tui disable +focus cmd +b _start +c # x/8xg $sp \ No newline at end of file diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index e54c125a3..1be02822f 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -1,122 +1,122 @@ -#define _GNU_SOURCE -#include -#include -#include -#include -#include -#include - -// const uint16_t MAX_APPS = 100; -// const uint8_t MAX_ARGS = 4; -#define MAX_APPS 100 -#define MAX_ARGS 4 - - -int64_t min(int64_t a, int64_t b) { - if (a < b) return a; - else return b; -} - -struct Func -{ - uint8_t argscnt; - uint8_t cnt; - void *ptr; - int64_t *argsfun; -}; -struct Func func_init(void *ptr, uint8_t cnt) { - struct Func new; - new.ptr = ptr; - new.argscnt = cnt; - new.argsfun = malloc(sizeof(int64_t)*min((int64_t)MAX_ARGS, cnt)); - new.cnt = 0; - return new; -} -struct Func *part_apps; -uint16_t last_app = 0; - -int64_t app_n(struct Func *f) { - switch ((*f).argscnt) { - case 0: - int64_t(*f_ptr0)(); - f_ptr0 = (*f).ptr; - return f_ptr0(); - case 1: - int64_t(*f_ptr1)(int64_t); - f_ptr1 = (*f).ptr; - return f_ptr1(f->argsfun[0]); - case 2: - int64_t(*f_ptr2)(int64_t, int64_t); - f_ptr2 = (*f).ptr; - return f_ptr2(f->argsfun[0], f->argsfun[1]); - case 3: - int64_t(*f_ptr3)(int64_t, int64_t, int64_t); - f_ptr3 = (*f).ptr; - return f_ptr3(f->argsfun[0], f->argsfun[1], f->argsfun[2]); - case 4: - int64_t(*f_ptr4)(int64_t, int64_t, int64_t, int64_t); - f_ptr4 = (*f).ptr; - return f_ptr4(f->argsfun[0], f->argsfun[1], f->argsfun[2], f->argsfun[3]); - default: - return -1; - } -} - -int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { - uint8_t f_cnt = f->cnt; - for (; f->cnt < min(MAX_ARGS, min(f_cnt + cnt, f->argscnt)); f->cnt++) { - f->argsfun[f->cnt] = args[f->cnt - f_cnt]; - } - int64_t ret; - if (f->cnt < f->argscnt) { - return (int64_t)f; - } else { - ret = app_n(f); - } - if (f_cnt + cnt > f->argscnt) { - int64_t new_args[MAX_ARGS]; - for (int i = f->argscnt - f_cnt; i < min(MAX_ARGS, cnt); i++) { - new_args[i - (f->argscnt - f_cnt)] = args[i]; - } - return app((void*)ret, f_cnt + cnt - f->argscnt, new_args); - } - else return ret; -} - -int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { - int cnt = 0; - int64_t args[MAX_ARGS]; - va_list argptr; - va_start(argptr, appcnt); - for (int i = 0; i < min(appcnt, MAX_ARGS); i++) { - args[i] = va_arg(argptr, int64_t); - } - va_end(argptr); - if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS]) { - part_apps[last_app] = *(struct Func *)f_ptr; - } else { - part_apps[last_app] = func_init(f_ptr, argcnt); - } - last_app = (last_app + 1) % MAX_APPS; - return app(&part_apps[last_app-1], appcnt, args); -} - -void init_part_apps() { - part_apps = malloc(sizeof(struct Func) * MAX_APPS); -} - -int many_arg(int n,int n1,int n2,int n3,int n4,int n5,int n6,int n7,int n8,int n9,int n10,int n11,int n12,int n13) { - int ret = n+n1+n3+(n4/n2)+n5+n6+n7+n8+n9+n10+n11*n12*n13; - return ret % 256; -} - -int fun ( int a, int b) -{ - return(10*a+b); -} - -int notmain () -{ - return many_arg(0,1,2,3,4,5,6,7,8,9,10,11,12,13); -} - +#define _GNU_SOURCE +#include +#include +#include +#include +#include +#include + +// const uint16_t MAX_APPS = 100; +// const uint8_t MAX_ARGS = 4; +#define MAX_APPS 100 +#define MAX_ARGS 4 + + +int64_t min(int64_t a, int64_t b) { + if (a < b) return a; + else return b; +} + +struct Func +{ + uint8_t argscnt; + uint8_t cnt; + void *ptr; + int64_t *argsfun; +}; +struct Func func_init(void *ptr, uint8_t cnt) { + struct Func new; + new.ptr = ptr; + new.argscnt = cnt; + new.argsfun = malloc(sizeof(int64_t)*min((int64_t)MAX_ARGS, cnt)); + new.cnt = 0; + return new; +} +struct Func *part_apps; +uint16_t last_app = 0; + +int64_t app_n(struct Func *f) { + switch ((*f).argscnt) { + case 0: + int64_t(*f_ptr0)(); + f_ptr0 = (*f).ptr; + return f_ptr0(); + case 1: + int64_t(*f_ptr1)(int64_t); + f_ptr1 = (*f).ptr; + return f_ptr1(f->argsfun[0]); + case 2: + int64_t(*f_ptr2)(int64_t, int64_t); + f_ptr2 = (*f).ptr; + return f_ptr2(f->argsfun[0], f->argsfun[1]); + case 3: + int64_t(*f_ptr3)(int64_t, int64_t, int64_t); + f_ptr3 = (*f).ptr; + return f_ptr3(f->argsfun[0], f->argsfun[1], f->argsfun[2]); + case 4: + int64_t(*f_ptr4)(int64_t, int64_t, int64_t, int64_t); + f_ptr4 = (*f).ptr; + return f_ptr4(f->argsfun[0], f->argsfun[1], f->argsfun[2], f->argsfun[3]); + default: + return -1; + } +} + +int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { + uint8_t f_cnt = f->cnt; + for (; f->cnt < min(MAX_ARGS, min(f_cnt + cnt, f->argscnt)); f->cnt++) { + f->argsfun[f->cnt] = args[f->cnt - f_cnt]; + } + int64_t ret; + if (f->cnt < f->argscnt) { + return (int64_t)f; + } else { + ret = app_n(f); + } + if (f_cnt + cnt > f->argscnt) { + int64_t new_args[MAX_ARGS]; + for (int i = f->argscnt - f_cnt; i < min(MAX_ARGS, cnt); i++) { + new_args[i - (f->argscnt - f_cnt)] = args[i]; + } + return app((void*)ret, f_cnt + cnt - f->argscnt, new_args); + } + else return ret; +} + +int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { + int cnt = 0; + int64_t args[MAX_ARGS]; + va_list argptr; + va_start(argptr, appcnt); + for (int i = 0; i < min(appcnt, MAX_ARGS); i++) { + args[i] = va_arg(argptr, int64_t); + } + va_end(argptr); + if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS]) { + part_apps[last_app] = *(struct Func *)f_ptr; + } else { + part_apps[last_app] = func_init(f_ptr, argcnt); + } + last_app = (last_app + 1) % MAX_APPS; + return app(&part_apps[last_app-1], appcnt, args); +} + +void init_part_apps() { + part_apps = malloc(sizeof(struct Func) * MAX_APPS); +} + +int many_arg(int n,int n1,int n2,int n3,int n4,int n5,int n6,int n7,int n8,int n9,int n10,int n11,int n12,int n13) { + int ret = n+n1+n3+(n4/n2)+n5+n6+n7+n8+n9+n10+n11*n12*n13; + return ret % 256; +} + +int fun ( int a, int b) +{ + return(10*a+b); +} + +int notmain () +{ + return many_arg(0,1,2,3,4,5,6,7,8,9,10,11,12,13); +} + diff --git a/slarnML/lib/riscv64/print.S b/slarnML/lib/riscv64/print.S index 3899d2f7e..f06f04e82 100644 --- a/slarnML/lib/riscv64/print.S +++ b/slarnML/lib/riscv64/print.S @@ -1,86 +1,86 @@ -.global print_char -.global print_int - -print_char: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - - sd a0,-24(s0) - addi a1,s0,-24 - li a0, 1 - li a7, 64 - li a2, 1 - ecall - - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 - ret - -print_uint: - addi sp,sp,-64 - sd ra,56(sp) - sd s0,48(sp) - addi s0,sp,64 - - li t0,10 # const - li t1, 8 - li a2, 0 # buffer_size - addi s1,s0,-24 - - .loop1: - li a4,0 - li t2,0 - .loop2: - rem a5,a0,t0 - addi a5,a5,48 - slli a4,a4, 8 - add a4,a4,a5 - addi t2,t2, 1 - div a0,a0,t0 - - beq t1,t2, .end_loop2 - beqz a0, .end_loop2 - j .loop2 - .end_loop2: - sd a4,0(s1) - addi a2,a2, 8 - addi s1,s1,-8 - beqz a0, .end_loop1 - j .loop1 - .end_loop1: - - li a0, 1 - addi a1,s1,8 # & - li a7, 64 # write - ecall - - - ld ra,56(sp) - ld s0,48(sp) - addi sp,sp,64 - ret - -print_int: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 - - bge a0,zero, .posit - li a3,-1 - mul a0,a0,a3 - sd a0,-24(s0) - li a0,45 # '-' - call print_char - - ld a0,-24(s0) - .posit: - call print_uint - - ld ra,40(sp) - ld s0,32(sp) - addi sp,sp,48 - ret +.global print_char +.global print_int + +print_char: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + + sd a0,-24(s0) + addi a1,s0,-24 + li a0, 1 + li a7, 64 + li a2, 1 + ecall + + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + +print_uint: + addi sp,sp,-64 + sd ra,56(sp) + sd s0,48(sp) + addi s0,sp,64 + + li t0,10 # const + li t1, 8 + li a2, 0 # buffer_size + addi s1,s0,-24 + + .loop1: + li a4,0 + li t2,0 + .loop2: + rem a5,a0,t0 + addi a5,a5,48 + slli a4,a4, 8 + add a4,a4,a5 + addi t2,t2, 1 + div a0,a0,t0 + + beq t1,t2, .end_loop2 + beqz a0, .end_loop2 + j .loop2 + .end_loop2: + sd a4,0(s1) + addi a2,a2, 8 + addi s1,s1,-8 + beqz a0, .end_loop1 + j .loop1 + .end_loop1: + + li a0, 1 + addi a1,s1,8 # & + li a7, 64 # write + ecall + + + ld ra,56(sp) + ld s0,48(sp) + addi sp,sp,64 + ret + +print_int: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + + bge a0,zero, .posit + li a3,-1 + mul a0,a0,a3 + sd a0,-24(s0) + li a0,45 # '-' + call print_char + + ld a0,-24(s0) + .posit: + call print_uint + + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index ed8cf4daa..eb1270d81 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -309,15 +309,15 @@ let init_args args res = >>= fun c_env -> res >>= (fun env -> - fold_right - (fun a r -> - r - >>= fun (offset, lst, e) -> - Result e - |> s_right_arg offset a - >>= fun (instr, e) -> Result (offset - 8, instr @ lst, e)) - right - (Result ((r_len - 1) * 8, [], env))) + fold_right + (fun a r -> + r + >>= fun (offset, lst, e) -> + Result e + |> s_right_arg offset a + >>= fun (instr, e) -> Result (offset - 8, instr @ lst, e)) + right + (Result ((r_len - 1) * 8, [], env))) >>= fun (_, right, env) -> fold_left (fun r a -> @@ -476,24 +476,24 @@ let rec build_aexpr tag a res = let dflt_bnch res = res >>= (fun (instr0, reg, env) -> - Result ([], None, env) - |> build_aexpr tag e1 - >>= fun (instr1, reg1, env) -> - (match reg1 with - | Some reg when reg <> A 0 -> - Result env - |> free_a0 - >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) - | Some _ -> Result ([], env) - | _ -> Error "Error in if") - >>= fun (instr2, env) -> - Result - ( instr0 - @ (Beqz (reg, get_tag_addr id) :: instr1) - @ instr2 - @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] - , Some (A 0) - , env )) + Result ([], None, env) + |> build_aexpr tag e1 + >>= fun (instr1, reg1, env) -> + (match reg1 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result + ( instr0 + @ (Beqz (reg, get_tag_addr id) :: instr1) + @ instr2 + @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] + , Some (A 0) + , env )) |> build_aexpr tag e2 >>= fun (instr1, reg2, env) -> (match reg2 with @@ -515,23 +515,23 @@ let rec build_aexpr tag a res = | Some (_, cond) -> res >>= (fun env -> - Result ([], None, env) - |> build_aexpr tag e1 - >>= fun (instr1, reg1, env) -> - (match reg1 with - | Some reg when reg <> A 0 -> - Result env - |> free_a0 - >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) - | Some _ -> Result ([], env) - | _ -> Error "Error in if") - >>= fun (instr2, env) -> - Result - ( (cond :: instr1) - @ instr2 - @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] - , Some (A 0) - , env )) + Result ([], None, env) + |> build_aexpr tag e1 + >>= fun (instr1, reg1, env) -> + (match reg1 with + | Some reg when reg <> A 0 -> + Result env + |> free_a0 + >>= fun (instr, env) -> Result (instr @ [ Mv (A 0, reg) ], env) + | Some _ -> Result ([], env) + | _ -> Error "Error in if") + >>= fun (instr2, env) -> + Result + ( (cond :: instr1) + @ instr2 + @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] + , Some (A 0) + , env )) |> build_aexpr tag e2 >>= fun (instr1, reg2, env) -> (match reg2 with diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 205e43e00..dc51a7531 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -1,647 +1,647 @@ - $ dune exec anf_conv_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - (fun anon$1(n f x)-> - (let anf_app#1=(n ) - in - (let anf_app#2=(f anf_app#1) - in - (let anf_op#3=(x*anf_app#2) - in - anf_op#3))) - ) - (fun fack(n f)-> - (let anf_op#4=(n<=1) - in - (let anf_if#5=if (anf_op#4) - then ( - (let anf_app#6=(f 1) - in - anf_app#6) - ) else ( - (let anf_op#7=(n-1) - in - (let anf_app#8=(n ) - in - (let anf_app#9=(f ) - in - (let anf_app#10=(anon$1 anf_app#8 anf_app#9) - in - (let anf_app#11=(fack anf_op#7 anf_app#10) - in - anf_app#11)))))) - in - anf_if#5)) - ) - (fun anon$2(x)-> - x - ) - (fun fac(n)-> - (let anf_op#12=(n<=1) - in - (let anf_if#13=if (anf_op#12) - then ( - (let anf_app#14=(f 1) - in - anf_app#14) - ) else ( - (let anf_op#15=(n-1) - in - (let anf_app#16=(n ) - in - (let anf_app#17=(f ) - in - (let anf_app#18=(anon$1 anf_app#16 anf_app#17) - in - (let anf_app#19=(fack anf_op#15 anf_app#18) - in - anf_app#19)))))) - in - (let anf_fack#20=(anf_if#13 ) - in - (let anf_app#21=(n ) - in - (let anf_app#22=(anon$2 ) - in - (let anf_app#23=(fack anf_app#21 anf_app#22) - in - anf_app#23)))))) - ) - $ dune exec anf_conv_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - (fun fack(n)-> - (let anf_op#1=(n<1) - in - (let anf_if#2=if (anf_op#1) - then ( - n - ) else ( - (let anf_op#3=(n-1) - in - (let anf_app#4=(fack anf_op#3) - in - (let anf_op#5=(n*anf_app#4) - in - anf_op#5)))) - in - anf_if#2)) - ) - (fun fac(n)-> - (let anf_op#6=(n<1) - in - (let anf_if#7=if (anf_op#6) - then ( - n - ) else ( - (let anf_op#8=(n-1) - in - (let anf_app#9=(fack anf_op#8) - in - (let anf_op#10=(n*anf_app#9) - in - anf_op#10)))) - in - (let anf_fack#11=(anf_if#7 ) - in - (let anf_app#12=(n ) - in - (let anf_app#13=(fack anf_app#12) - in - anf_app#13))))) - ) - $ dune exec anf_conv_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - (fun h(a c d e)-> - (let anf_app#1=(a ) - in - (let anf_app#2=(c ) - in - (let anf_app#3=(d ) - in - (let anf_app#4=(e ) - in - (let anf_op#5=(anf_app#3*anf_app#4) - in - (let anf_op#6=(anf_app#2+anf_op#5) - in - (let anf_op#7=(anf_app#1*anf_op#6) - in - anf_op#7))))))) - ) - (fun g(a c d)-> - (let anf_app#8=(a ) - in - (let anf_app#9=(c ) - in - (let anf_app#10=(d ) - in - (let anf_app#11=(e ) - in - (let anf_op#12=(anf_app#10*anf_app#11) - in - (let anf_op#13=(anf_app#9+anf_op#12) - in - (let anf_op#14=(anf_app#8*anf_op#13) - in - (let anf_h#15=(anf_op#14 ) - in - (let anf_app#16=(a ) - in - (let anf_app#17=(c ) - in - (let anf_app#18=(d ) - in - (let anf_app#19=(h anf_app#16 anf_app#17 anf_app#18 4) - in - anf_app#19)))))))))))) - ) - (fun f(a)-> - (let anf_app#20=(a ) - in - (let anf_app#21=(c ) - in - (let anf_app#22=(d ) - in - (let anf_app#23=(e ) - in - (let anf_op#24=(anf_app#22*anf_app#23) - in - (let anf_op#25=(anf_app#21+anf_op#24) - in - (let anf_op#26=(anf_app#20*anf_op#25) - in - (let anf_h#27=(anf_op#26 ) - in - (let anf_app#28=(a ) - in - (let anf_app#29=(c ) - in - (let anf_app#30=(d ) - in - (let anf_app#31=(h anf_app#28 anf_app#29 anf_app#30 4) - in - (let anf_g#32=(anf_app#31 ) - in - (let anf_app#33=(a ) - in - (let anf_app#34=(g anf_app#33 2 3) - in - anf_app#34))))))))))))))) - ) - $ dune exec anf_conv_test < manytests/do_not_type/001.ml - fac not exist - $ dune exec anf_conv_test < manytests/do_not_type/002if.ml - (fun main()-> - (let anf_if#1=if (true) - then ( - 1 - ) else ( - false) - in - anf_if#1) - ) - $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml - f not exist - $ dune exec anf_conv_test < manytests/typed/001fac.ml - (fun fac(n)-> - (let anf_op#1=(n<=1) - in - (let anf_if#2=if (anf_op#1) - then ( - 1 - ) else ( - (let anf_op#3=(n-1) - in - (let anf_app#4=(fac anf_op#3) - in - (let anf_op#5=(n*anf_app#4) - in - anf_op#5)))) - in - anf_if#2)) - ) - (fun main()-> - (let anf_app#6=(fac 4) - in - (let anf_app#7=(print_int anf_app#6) - in - (let anf_()#8=(anf_app#7 ) - in - 0))) - ) - $ dune exec anf_conv_test < manytests/typed/002fac.ml - (fun anon$1(n k p)-> - (let anf_op#1=(p*n) - in - (let anf_app#2=(k anf_op#1) - in - anf_app#2)) - ) - (fun fac_cps(n k)-> - (let anf_op#3=(n=1) - in - (let anf_if#4=if (anf_op#3) - then ( - (let anf_app#5=(k 1) - in - anf_app#5) - ) else ( - (let anf_op#6=(n-1) - in - (let anf_app#7=(n ) - in - (let anf_app#8=(k ) - in - (let anf_app#9=(anon$1 anf_app#7 anf_app#8) - in - (let anf_app#10=(fac_cps anf_op#6 anf_app#9) - in - anf_app#10)))))) - in - anf_if#4)) - ) - (fun anon$1(print_int)-> - print_int - ) - (fun main()-> - (let anf_app#11=(anon$1 ) - in - (let anf_app#12=(fac_cps 4 anf_app#11) - in - (let anf_app#13=(print_int anf_app#12) - in - (let anf_()#14=(anf_app#13 ) - in - 0)))) - ) - $ dune exec anf_conv_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/004manyargs.ml - (fun wrap(f)-> - (let anf_op#1=(1=1) - in - (let anf_if#2=if (anf_op#1) - then ( - (let anf_app#3=(f ) - in - anf_app#3) - ) else ( - (let anf_app#4=(f ) - in - anf_app#4)) - in - anf_if#2)) - ) - (fun a(a)-> - (let anf_app#5=(a ) - in - (let anf_app#6=(print_int anf_app#5) - in - anf_app#6)) - ) - (fun b(b)-> - (let anf_app#7=(b ) - in - (let anf_app#8=(print_int anf_app#7) - in - anf_app#8)) - ) - (fun c(c)-> - (let anf_app#9=(c ) - in - (let anf_app#10=(print_int anf_app#9) - in - anf_app#10)) - ) - (fun test3(a b c)-> - (let anf_app#11=(a ) - in - (let anf_app#12=(print_int anf_app#11) - in - (let anf_a#13=(anf_app#12 ) - in - (let anf_app#14=(b ) - in - (let anf_app#15=(print_int anf_app#14) - in - (let anf_b#16=(anf_app#15 ) - in - (let anf_app#17=(c ) - in - (let anf_app#18=(print_int anf_app#17) - in - (let anf_c#19=(anf_app#18 ) - in - 0))))))))) - ) - (fun test10(a b c d e f g h i j)-> - (let anf_app#20=(a ) - in - (let anf_app#21=(b ) - in - (let anf_op#22=(anf_app#20+anf_app#21) - in - (let anf_app#23=(c ) - in - (let anf_op#24=(anf_op#22+anf_app#23) - in - (let anf_app#25=(d ) - in - (let anf_op#26=(anf_op#24+anf_app#25) - in - (let anf_app#27=(e ) - in - (let anf_op#28=(anf_op#26+anf_app#27) - in - (let anf_app#29=(f ) - in - (let anf_op#30=(anf_op#28+anf_app#29) - in - (let anf_app#31=(g ) - in - (let anf_op#32=(anf_op#30+anf_app#31) - in - (let anf_app#33=(h ) - in - (let anf_op#34=(anf_op#32+anf_app#33) - in - (let anf_app#35=(i ) - in - (let anf_op#36=(anf_op#34+anf_app#35) - in - (let anf_app#37=(j ) - in - (let anf_op#38=(anf_op#36+anf_app#37) - in - anf_op#38))))))))))))))))))) - ) - (fun temp0()-> - (let anf_app#39=(test10 ) - in - (let anf_app#40=(wrap anf_app#39 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) - in - anf_app#40)) - ) - (fun temp1(temp0)-> - (let anf_app#41=(temp0 ) - in - (let anf_app#42=(print_int anf_app#41) - in - anf_app#42)) - ) - (fun temp2()-> - (let anf_app#43=(test3 ) - in - (let anf_app#44=(wrap anf_app#43 1 10 100) - in - anf_app#44)) - ) - (fun main()-> - (let anf_app#45=(test10 ) - in - (let anf_app#46=(wrap anf_app#45 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) - in - (let anf_temp0#47=(anf_app#46 ) - in - (let anf_app#48=(temp0 ) - in - (let anf_app#49=(print_int anf_app#48) - in - (let anf_temp1#50=(anf_app#49 ) - in - (let anf_app#51=(test3 ) - in - (let anf_app#52=(wrap anf_app#51 1 10 100) - in - (let anf_temp2#53=(anf_app#52 ) - in - 0))))))))) - ) - $ dune exec anf_conv_test < manytests/typed/005fix.ml - (fun fix(f x)-> - (let anf_app#1=(f ) - in - (let anf_app#2=(fix anf_app#1) - in - (let anf_app#3=(x ) - in - (let anf_app#4=(f anf_app#2 anf_app#3) - in - anf_app#4)))) - ) - (fun fac(self n)-> - (let anf_app#5=(n ) - in - (let anf_op#6=(anf_app#5<=1) - in - (let anf_if#7=if (anf_op#6) - then ( - 1 - ) else ( - (let anf_app#8=(n ) - in - (let anf_app#9=(n ) - in - (let anf_op#10=(anf_app#9-1) - in - (let anf_app#11=(self anf_op#10) - in - (let anf_op#12=(anf_app#8*anf_app#11) - in - anf_op#12)))))) - in - anf_if#7))) - ) - (fun main()-> - (let anf_app#13=(fac ) - in - (let anf_app#14=(fix anf_app#13 6) - in - (let anf_app#15=(print_int anf_app#14) - in - (let anf_()#16=(anf_app#15 ) - in - 0)))) - ) - $ dune exec anf_conv_test < manytests/typed/006partial.ml - (fun anon$1(foo)-> - (let anf_op#1=(foo+2) - in - anf_op#1) - ) - (fun anon$2(foo)-> - (let anf_op#2=(foo*10) - in - anf_op#2) - ) - (fun foo(b)-> - (let anf_app#3=(b ) - in - (let anf_if#4=if (anf_app#3) - then ( - (let anf_app#5=(anon$1 ) - in - anf_app#5) - ) else ( - (let anf_app#6=(anon$2 ) - in - anf_app#6)) - in - anf_if#4)) - ) - (fun foo(x)-> - (let anf_app#7=(x ) - in - (let anf_app#8=(foo false anf_app#7) - in - (let anf_app#9=(foo true anf_app#8) - in - (let anf_app#10=(foo false anf_app#9) - in - (let anf_app#11=(foo true anf_app#10) - in - anf_app#11))))) - ) - (fun main()-> - (let anf_app#12=(foo 11) - in - (let anf_app#13=(print_int anf_app#12) - in - (let anf_()#14=(anf_app#13 ) - in - 0))) - ) - $ dune exec anf_conv_test < manytests/typed/006partial2.ml - (fun foo(a b c)-> - (let anf_app#1=(a ) - in - (let anf_app#2=(print_int anf_app#1) - in - (let anf_()#3=(anf_app#2 ) - in - (let anf_app#4=(b ) - in - (let anf_app#5=(print_int anf_app#4) - in - (let anf_()#6=(anf_app#5 ) - in - (let anf_app#7=(c ) - in - (let anf_app#8=(print_int anf_app#7) - in - (let anf_()#9=(anf_app#8 ) - in - (let anf_app#10=(a ) - in - (let anf_app#11=(b ) - in - (let anf_app#12=(c ) - in - (let anf_op#13=(anf_app#11*anf_app#12) - in - (let anf_op#14=(anf_app#10+anf_op#13) - in - anf_op#14)))))))))))))) - ) - (fun foo()-> - (let anf_app#15=(foo 1) - in - anf_app#15) - ) - (fun foo(foo)-> - (let anf_app#16=(foo ) - in - (let anf_app#17=(foo anf_app#16 2) - in - anf_app#17)) - ) - (fun foo(foo)-> - (let anf_app#18=(foo ) - in - (let anf_app#19=(foo anf_app#18 3) - in - anf_app#19)) - ) - (fun main()-> - (let anf_app#20=(foo 1) - in - (let anf_foo#21=(anf_app#20 ) - in - (let anf_app#22=(foo ) - in - (let anf_app#23=(foo anf_app#22 2) - in - (let anf_foo#24=(anf_app#23 ) - in - (let anf_app#25=(foo ) - in - (let anf_app#26=(foo anf_app#25 3) - in - (let anf_foo#27=(anf_app#26 ) - in - (let anf_app#28=(foo ) - in - (let anf_app#29=(print_int anf_app#28) - in - (let anf_()#30=(anf_app#29 ) - in - 0))))))))))) - ) - $ dune exec anf_conv_test < manytests/typed/006partial3.ml - (fun anon$2(c)-> - (let anf_app#1=(c ) - in - (let anf_app#2=(print_int anf_app#1) - in - anf_app#2)) - ) - (fun anon$1(b)-> - (let anf_app#3=(b ) - in - (let anf_app#4=(print_int anf_app#3) - in - (let anf_()#5=(anf_app#4 ) - in - (let anf_app#6=(anon$2 ) - in - anf_app#6)))) - ) - (fun foo(a)-> - (let anf_app#7=(a ) - in - (let anf_app#8=(print_int anf_app#7) - in - (let anf_()#9=(anf_app#8 ) - in - (let anf_app#10=(anon$1 ) - in - anf_app#10)))) - ) - (fun main()-> - (let anf_app#11=(foo 4 8 9) - in - (let anf_()#12=(anf_app#11 ) - in - 0)) - ) - $ dune exec anf_conv_test < manytests/typed/007order.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec anf_conv_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec anf_conv_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (fun anon$1(n f x)-> + (let anf_app#1=(n ) + in + (let anf_app#2=(f anf_app#1) + in + (let anf_op#3=(x*anf_app#2) + in + anf_op#3))) + ) + (fun fack(n f)-> + (let anf_op#4=(n<=1) + in + (let anf_if#5=if (anf_op#4) + then ( + (let anf_app#6=(f 1) + in + anf_app#6) + ) else ( + (let anf_op#7=(n-1) + in + (let anf_app#8=(n ) + in + (let anf_app#9=(f ) + in + (let anf_app#10=(anon$1 anf_app#8 anf_app#9) + in + (let anf_app#11=(fack anf_op#7 anf_app#10) + in + anf_app#11)))))) + in + anf_if#5)) + ) + (fun anon$2(x)-> + x + ) + (fun fac(n)-> + (let anf_op#12=(n<=1) + in + (let anf_if#13=if (anf_op#12) + then ( + (let anf_app#14=(f 1) + in + anf_app#14) + ) else ( + (let anf_op#15=(n-1) + in + (let anf_app#16=(n ) + in + (let anf_app#17=(f ) + in + (let anf_app#18=(anon$1 anf_app#16 anf_app#17) + in + (let anf_app#19=(fack anf_op#15 anf_app#18) + in + anf_app#19)))))) + in + (let anf_fack#20=(anf_if#13 ) + in + (let anf_app#21=(n ) + in + (let anf_app#22=(anon$2 ) + in + (let anf_app#23=(fack anf_app#21 anf_app#22) + in + anf_app#23)))))) + ) + $ dune exec anf_conv_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (fun fack(n)-> + (let anf_op#1=(n<1) + in + (let anf_if#2=if (anf_op#1) + then ( + n + ) else ( + (let anf_op#3=(n-1) + in + (let anf_app#4=(fack anf_op#3) + in + (let anf_op#5=(n*anf_app#4) + in + anf_op#5)))) + in + anf_if#2)) + ) + (fun fac(n)-> + (let anf_op#6=(n<1) + in + (let anf_if#7=if (anf_op#6) + then ( + n + ) else ( + (let anf_op#8=(n-1) + in + (let anf_app#9=(fack anf_op#8) + in + (let anf_op#10=(n*anf_app#9) + in + anf_op#10)))) + in + (let anf_fack#11=(anf_if#7 ) + in + (let anf_app#12=(n ) + in + (let anf_app#13=(fack anf_app#12) + in + anf_app#13))))) + ) + $ dune exec anf_conv_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (fun h(a c d e)-> + (let anf_app#1=(a ) + in + (let anf_app#2=(c ) + in + (let anf_app#3=(d ) + in + (let anf_app#4=(e ) + in + (let anf_op#5=(anf_app#3*anf_app#4) + in + (let anf_op#6=(anf_app#2+anf_op#5) + in + (let anf_op#7=(anf_app#1*anf_op#6) + in + anf_op#7))))))) + ) + (fun g(a c d)-> + (let anf_app#8=(a ) + in + (let anf_app#9=(c ) + in + (let anf_app#10=(d ) + in + (let anf_app#11=(e ) + in + (let anf_op#12=(anf_app#10*anf_app#11) + in + (let anf_op#13=(anf_app#9+anf_op#12) + in + (let anf_op#14=(anf_app#8*anf_op#13) + in + (let anf_h#15=(anf_op#14 ) + in + (let anf_app#16=(a ) + in + (let anf_app#17=(c ) + in + (let anf_app#18=(d ) + in + (let anf_app#19=(h anf_app#16 anf_app#17 anf_app#18 4) + in + anf_app#19)))))))))))) + ) + (fun f(a)-> + (let anf_app#20=(a ) + in + (let anf_app#21=(c ) + in + (let anf_app#22=(d ) + in + (let anf_app#23=(e ) + in + (let anf_op#24=(anf_app#22*anf_app#23) + in + (let anf_op#25=(anf_app#21+anf_op#24) + in + (let anf_op#26=(anf_app#20*anf_op#25) + in + (let anf_h#27=(anf_op#26 ) + in + (let anf_app#28=(a ) + in + (let anf_app#29=(c ) + in + (let anf_app#30=(d ) + in + (let anf_app#31=(h anf_app#28 anf_app#29 anf_app#30 4) + in + (let anf_g#32=(anf_app#31 ) + in + (let anf_app#33=(a ) + in + (let anf_app#34=(g anf_app#33 2 3) + in + anf_app#34))))))))))))))) + ) + $ dune exec anf_conv_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec anf_conv_test < manytests/do_not_type/002if.ml + (fun main()-> + (let anf_if#1=if (true) + then ( + 1 + ) else ( + false) + in + anf_if#1) + ) + $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml + f not exist + $ dune exec anf_conv_test < manytests/typed/001fac.ml + (fun fac(n)-> + (let anf_op#1=(n<=1) + in + (let anf_if#2=if (anf_op#1) + then ( + 1 + ) else ( + (let anf_op#3=(n-1) + in + (let anf_app#4=(fac anf_op#3) + in + (let anf_op#5=(n*anf_app#4) + in + anf_op#5)))) + in + anf_if#2)) + ) + (fun main()-> + (let anf_app#6=(fac 4) + in + (let anf_app#7=(print_int anf_app#6) + in + (let anf_()#8=(anf_app#7 ) + in + 0))) + ) + $ dune exec anf_conv_test < manytests/typed/002fac.ml + (fun anon$1(n k p)-> + (let anf_op#1=(p*n) + in + (let anf_app#2=(k anf_op#1) + in + anf_app#2)) + ) + (fun fac_cps(n k)-> + (let anf_op#3=(n=1) + in + (let anf_if#4=if (anf_op#3) + then ( + (let anf_app#5=(k 1) + in + anf_app#5) + ) else ( + (let anf_op#6=(n-1) + in + (let anf_app#7=(n ) + in + (let anf_app#8=(k ) + in + (let anf_app#9=(anon$1 anf_app#7 anf_app#8) + in + (let anf_app#10=(fac_cps anf_op#6 anf_app#9) + in + anf_app#10)))))) + in + anf_if#4)) + ) + (fun anon$1(print_int)-> + print_int + ) + (fun main()-> + (let anf_app#11=(anon$1 ) + in + (let anf_app#12=(fac_cps 4 anf_app#11) + in + (let anf_app#13=(print_int anf_app#12) + in + (let anf_()#14=(anf_app#13 ) + in + 0)))) + ) + $ dune exec anf_conv_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/004manyargs.ml + (fun wrap(f)-> + (let anf_op#1=(1=1) + in + (let anf_if#2=if (anf_op#1) + then ( + (let anf_app#3=(f ) + in + anf_app#3) + ) else ( + (let anf_app#4=(f ) + in + anf_app#4)) + in + anf_if#2)) + ) + (fun a(a)-> + (let anf_app#5=(a ) + in + (let anf_app#6=(print_int anf_app#5) + in + anf_app#6)) + ) + (fun b(b)-> + (let anf_app#7=(b ) + in + (let anf_app#8=(print_int anf_app#7) + in + anf_app#8)) + ) + (fun c(c)-> + (let anf_app#9=(c ) + in + (let anf_app#10=(print_int anf_app#9) + in + anf_app#10)) + ) + (fun test3(a b c)-> + (let anf_app#11=(a ) + in + (let anf_app#12=(print_int anf_app#11) + in + (let anf_a#13=(anf_app#12 ) + in + (let anf_app#14=(b ) + in + (let anf_app#15=(print_int anf_app#14) + in + (let anf_b#16=(anf_app#15 ) + in + (let anf_app#17=(c ) + in + (let anf_app#18=(print_int anf_app#17) + in + (let anf_c#19=(anf_app#18 ) + in + 0))))))))) + ) + (fun test10(a b c d e f g h i j)-> + (let anf_app#20=(a ) + in + (let anf_app#21=(b ) + in + (let anf_op#22=(anf_app#20+anf_app#21) + in + (let anf_app#23=(c ) + in + (let anf_op#24=(anf_op#22+anf_app#23) + in + (let anf_app#25=(d ) + in + (let anf_op#26=(anf_op#24+anf_app#25) + in + (let anf_app#27=(e ) + in + (let anf_op#28=(anf_op#26+anf_app#27) + in + (let anf_app#29=(f ) + in + (let anf_op#30=(anf_op#28+anf_app#29) + in + (let anf_app#31=(g ) + in + (let anf_op#32=(anf_op#30+anf_app#31) + in + (let anf_app#33=(h ) + in + (let anf_op#34=(anf_op#32+anf_app#33) + in + (let anf_app#35=(i ) + in + (let anf_op#36=(anf_op#34+anf_app#35) + in + (let anf_app#37=(j ) + in + (let anf_op#38=(anf_op#36+anf_app#37) + in + anf_op#38))))))))))))))))))) + ) + (fun temp0()-> + (let anf_app#39=(test10 ) + in + (let anf_app#40=(wrap anf_app#39 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + in + anf_app#40)) + ) + (fun temp1(temp0)-> + (let anf_app#41=(temp0 ) + in + (let anf_app#42=(print_int anf_app#41) + in + anf_app#42)) + ) + (fun temp2()-> + (let anf_app#43=(test3 ) + in + (let anf_app#44=(wrap anf_app#43 1 10 100) + in + anf_app#44)) + ) + (fun main()-> + (let anf_app#45=(test10 ) + in + (let anf_app#46=(wrap anf_app#45 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + in + (let anf_temp0#47=(anf_app#46 ) + in + (let anf_app#48=(temp0 ) + in + (let anf_app#49=(print_int anf_app#48) + in + (let anf_temp1#50=(anf_app#49 ) + in + (let anf_app#51=(test3 ) + in + (let anf_app#52=(wrap anf_app#51 1 10 100) + in + (let anf_temp2#53=(anf_app#52 ) + in + 0))))))))) + ) + $ dune exec anf_conv_test < manytests/typed/005fix.ml + (fun fix(f x)-> + (let anf_app#1=(f ) + in + (let anf_app#2=(fix anf_app#1) + in + (let anf_app#3=(x ) + in + (let anf_app#4=(f anf_app#2 anf_app#3) + in + anf_app#4)))) + ) + (fun fac(self n)-> + (let anf_app#5=(n ) + in + (let anf_op#6=(anf_app#5<=1) + in + (let anf_if#7=if (anf_op#6) + then ( + 1 + ) else ( + (let anf_app#8=(n ) + in + (let anf_app#9=(n ) + in + (let anf_op#10=(anf_app#9-1) + in + (let anf_app#11=(self anf_op#10) + in + (let anf_op#12=(anf_app#8*anf_app#11) + in + anf_op#12)))))) + in + anf_if#7))) + ) + (fun main()-> + (let anf_app#13=(fac ) + in + (let anf_app#14=(fix anf_app#13 6) + in + (let anf_app#15=(print_int anf_app#14) + in + (let anf_()#16=(anf_app#15 ) + in + 0)))) + ) + $ dune exec anf_conv_test < manytests/typed/006partial.ml + (fun anon$1(foo)-> + (let anf_op#1=(foo+2) + in + anf_op#1) + ) + (fun anon$2(foo)-> + (let anf_op#2=(foo*10) + in + anf_op#2) + ) + (fun foo(b)-> + (let anf_app#3=(b ) + in + (let anf_if#4=if (anf_app#3) + then ( + (let anf_app#5=(anon$1 ) + in + anf_app#5) + ) else ( + (let anf_app#6=(anon$2 ) + in + anf_app#6)) + in + anf_if#4)) + ) + (fun foo(x)-> + (let anf_app#7=(x ) + in + (let anf_app#8=(foo false anf_app#7) + in + (let anf_app#9=(foo true anf_app#8) + in + (let anf_app#10=(foo false anf_app#9) + in + (let anf_app#11=(foo true anf_app#10) + in + anf_app#11))))) + ) + (fun main()-> + (let anf_app#12=(foo 11) + in + (let anf_app#13=(print_int anf_app#12) + in + (let anf_()#14=(anf_app#13 ) + in + 0))) + ) + $ dune exec anf_conv_test < manytests/typed/006partial2.ml + (fun foo(a b c)-> + (let anf_app#1=(a ) + in + (let anf_app#2=(print_int anf_app#1) + in + (let anf_()#3=(anf_app#2 ) + in + (let anf_app#4=(b ) + in + (let anf_app#5=(print_int anf_app#4) + in + (let anf_()#6=(anf_app#5 ) + in + (let anf_app#7=(c ) + in + (let anf_app#8=(print_int anf_app#7) + in + (let anf_()#9=(anf_app#8 ) + in + (let anf_app#10=(a ) + in + (let anf_app#11=(b ) + in + (let anf_app#12=(c ) + in + (let anf_op#13=(anf_app#11*anf_app#12) + in + (let anf_op#14=(anf_app#10+anf_op#13) + in + anf_op#14)))))))))))))) + ) + (fun foo()-> + (let anf_app#15=(foo 1) + in + anf_app#15) + ) + (fun foo(foo)-> + (let anf_app#16=(foo ) + in + (let anf_app#17=(foo anf_app#16 2) + in + anf_app#17)) + ) + (fun foo(foo)-> + (let anf_app#18=(foo ) + in + (let anf_app#19=(foo anf_app#18 3) + in + anf_app#19)) + ) + (fun main()-> + (let anf_app#20=(foo 1) + in + (let anf_foo#21=(anf_app#20 ) + in + (let anf_app#22=(foo ) + in + (let anf_app#23=(foo anf_app#22 2) + in + (let anf_foo#24=(anf_app#23 ) + in + (let anf_app#25=(foo ) + in + (let anf_app#26=(foo anf_app#25 3) + in + (let anf_foo#27=(anf_app#26 ) + in + (let anf_app#28=(foo ) + in + (let anf_app#29=(print_int anf_app#28) + in + (let anf_()#30=(anf_app#29 ) + in + 0))))))))))) + ) + $ dune exec anf_conv_test < manytests/typed/006partial3.ml + (fun anon$2(c)-> + (let anf_app#1=(c ) + in + (let anf_app#2=(print_int anf_app#1) + in + anf_app#2)) + ) + (fun anon$1(b)-> + (let anf_app#3=(b ) + in + (let anf_app#4=(print_int anf_app#3) + in + (let anf_()#5=(anf_app#4 ) + in + (let anf_app#6=(anon$2 ) + in + anf_app#6)))) + ) + (fun foo(a)-> + (let anf_app#7=(a ) + in + (let anf_app#8=(print_int anf_app#7) + in + (let anf_()#9=(anf_app#8 ) + in + (let anf_app#10=(anon$1 ) + in + anf_app#10)))) + ) + (fun main()-> + (let anf_app#11=(foo 4 8 9) + in + (let anf_()#12=(anf_app#11 ) + in + 0)) + ) + $ dune exec anf_conv_test < manytests/typed/007order.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec anf_conv_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index cff624ac2..c9269e017 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -1,67 +1,68 @@ - $ dune exec clos_conv_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - (let fac n=(let rec fack n f=if ((n<=1)) then (((f ) 1)) else (((fack ) (n-1) ((fun n f x->(x*((f ) n))) n f))) in ((fack ) n ((fun x->x) )))) - $ dune exec clos_conv_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*((fack ) (n-1)))) in ((fack ) n))) - $ dune exec clos_conv_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - (let f a=(let g a c d=(let h a c d e=(a*(c+(d*e))) in ((h a c d) 4)) in ((g a) 2 3))) - $ dune exec clos_conv_test << EOF - > let rec fac n = if n<=1 then 1 else n * fac (n-1) - > - > let main = - > let () = print_int (fac 4) in - > 0 - > EOF - (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) - (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) - $ dune exec clos_conv_test < manytests/typed/001fac.ml - (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) - (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) - $ dune exec clos_conv_test < manytests/typed/002fac.ml - (let rec fac_cps n k=if ((n=1)) then (((k ) 1)) else (((fac_cps ) (n-1) ((fun n k p->((k ) (p*n))) n k)))) - (let main=(let ()=((print_int ) ((fac_cps ) 4 ((fun print_int->print_int) ))) in 0)) - $ dune exec clos_conv_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/004manyargs.ml - (let wrap f=if ((1=1)) then (f) else (f)) - (let test3 a b c=(let a a=((print_int ) a) in (let b b=((print_int ) b) in (let c c=((print_int ) c) in 0)))) - (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) - (let main=(let temp0=((wrap ) test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let temp1 temp0=((print_int ) temp0) in (let temp2=((wrap ) test3 1 10 100) in 0)))) - $ dune exec clos_conv_test < manytests/typed/005fix.ml - (let rec fix f x=((f ) ((fix ) f) x)) - (let fac self n=if ((n<=1)) then (1) else ((n*((self ) (n-1))))) - (let main=(let ()=((print_int ) ((fix ) fac 6)) in 0)) - $ dune exec clos_conv_test < manytests/typed/006partial.ml - (let foo b=if (b) then (((fun foo->(foo+2)) )) else (((fun foo->(foo*10)) ))) - (let foo x=((foo ) true ((foo ) false ((foo ) true ((foo ) false x))))) - (let main=(let ()=((print_int ) ((foo ) 11)) in 0)) - $ dune exec clos_conv_test < manytests/typed/006partial2.ml - (let foo a b c=(let ()=((print_int ) a) in (let ()=((print_int ) b) in (let ()=((print_int ) c) in (a+(b*c)))))) - (let main=(let foo=((foo ) 1) in (let foo foo=((foo foo) 2) in (let foo foo=((foo foo) 3) in (let ()=((print_int ) foo) in 0))))) - $ dune exec clos_conv_test < manytests/typed/006partial3.ml - (let foo a=(let ()=((print_int ) a) in ((fun b->(let ()=((print_int ) b) in ((fun c->((print_int ) c)) ))) ))) - (let main=(let ()=((foo ) 4 8 9) in 0)) - $ dune exec clos_conv_test < manytests/typed/007order.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec clos_conv_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec clos_conv_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (let fac n=(let rec fack n f=if ((n<=1)) then (((f ) 1)) else (((fack ) (n-1) ((fun n f x->(x*((f ) n))) n f))) in ((fack ) n ((fun x->x) )))) + $ dune exec clos_conv_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*((fack ) (n-1)))) in ((fack ) n))) + $ dune exec clos_conv_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (let f a=(let g a c d=(let h a c d e=(a*(c+(d*e))) in ((h a c d) 4)) in ((g a) 2 3))) + $ dune exec clos_conv_test << EOF + > let rec fac n = if n<=1 then 1 else n * fac (n-1) + > + > let main = + > let () = print_int (fac 4) in + > 0 + > EOF + (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) + (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) + $ dune exec clos_conv_test < manytests/typed/001fac.ml + (let rec fac n=if ((n<=1)) then (1) else ((n*((fac ) (n-1))))) + (let main=(let ()=((print_int ) ((fac ) 4)) in 0)) + $ dune exec clos_conv_test < manytests/typed/002fac.ml + (let rec fac_cps n k=if ((n=1)) then (((k ) 1)) else (((fac_cps ) (n-1) ((fun n k p->((k ) (p*n))) n k)))) + (let main=(let ()=((print_int ) ((fac_cps ) 4 ((fun print_int->print_int) ))) in 0)) + $ dune exec clos_conv_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/004manyargs.ml + (let wrap f=if ((1=1)) then (f) else (f)) + (let test3 a b c=(let a a=((print_int ) a) in (let b b=((print_int ) b) in (let c c=((print_int ) c) in 0)))) + (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) + (let main=(let temp0=((wrap ) test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let temp1 temp0=((print_int ) temp0) in (let temp2=((wrap ) test3 1 10 100) in 0)))) + $ dune exec clos_conv_test < manytests/typed/005fix.ml + (let rec fix f x=((f ) ((fix ) f) x)) + (let fac self n=if ((n<=1)) then (1) else ((n*((self ) (n-1))))) + (let main=(let ()=((print_int ) ((fix ) fac 6)) in 0)) + $ dune exec clos_conv_test < manytests/typed/006partial.ml + (let foo b=if (b) then (((fun foo->(foo+2)) )) else (((fun foo->(foo*10)) ))) + (let foo x=((foo ) true ((foo ) false ((foo ) true ((foo ) false x))))) + (let main=(let ()=((print_int ) ((foo ) 11)) in 0)) + $ dune exec clos_conv_test < manytests/typed/006partial2.ml + (let foo a b c=(let ()=((print_int ) a) in (let ()=((print_int ) b) in (let ()=((print_int ) c) in (a+(b*c)))))) + (let main=(let foo=((foo ) 1) in (let foo foo=((foo foo) 2) in (let foo foo=((foo foo) 3) in (let ()=((print_int ) foo) in 0))))) + $ dune exec clos_conv_test < manytests/typed/006partial3.ml + (let foo a=(let ()=((print_int ) a) in ((fun b->(let ()=((print_int ) b) in ((fun c->((print_int ) c)) ))) ))) + (let main=(let ()=((foo ) 4 8 9) in 0)) + $ dune exec clos_conv_test < manytests/typed/007order.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec clos_conv_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec clos_conv_test < test/manytests/typed/016lists.ml + test/manytests/typed/016lists.ml: No such file or directory + [1] diff --git a/slarnML/test/dune b/slarnML/test/dune index f5585a9be..d39d90c83 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -123,23 +123,23 @@ manytests/typed/015tuples.ml manytests/typed/016lists.ml)) -(cram - (applies_to exec_test) - (deps - ../lib/riscv64/print.S - ../lib/riscv64/part_app.c - manytests/do_not_type/001.ml - manytests/do_not_type/002if.ml - manytests/do_not_type/003occurs.ml - manytests/typed/001fac.ml - manytests/typed/002fac.ml - manytests/typed/003fib.ml - manytests/typed/004manyargs.ml - manytests/typed/005fix.ml - manytests/typed/006partial.ml - manytests/typed/006partial2.ml - manytests/typed/006partial3.ml - manytests/typed/007order.ml - manytests/typed/008ascription.ml - manytests/typed/015tuples.ml - manytests/typed/016lists.ml)) +;(cram +; (applies_to exec_test) +; (deps +; ../lib/riscv64/print.S +; ../lib/riscv64/part_app.c +; manytests/do_not_type/001.ml +; manytests/do_not_type/002if.ml +; manytests/do_not_type/003occurs.ml +; manytests/typed/001fac.ml +; manytests/typed/002fac.ml +; manytests/typed/003fib.ml +; manytests/typed/004manyargs.ml +; manytests/typed/005fix.ml +; manytests/typed/006partial.ml +; manytests/typed/006partial2.ml +; manytests/typed/006partial3.ml +; manytests/typed/007order.ml +; manytests/typed/008ascription.ml +; manytests/typed/015tuples.ml +; manytests/typed/016lists.ml)) diff --git a/slarnML/test/exec_test.t b/slarnML/test/exec_test.t_ similarity index 100% rename from slarnML/test/exec_test.t rename to slarnML/test/exec_test.t_ diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 5d88558f8..4f4150adb 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -1,85 +1,85 @@ - $ dune exec lambda_lifting_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - (fun anon$1(n f x)->((x*(f (n ))))) - (fun fack(n f)->(if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))))) - (fun anon$2(x)->(x)) - (fun fac(n)->(let fack = (if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))) in (fack (n ) (anon$2 ))))) - $ dune exec lambda_lifting_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - (fun fack(n)->(if ((n<1)) then (n) else ((n*(fack (n-1)))))) - (fun fac(n)->(let fack = (if ((n<1)) then (n) else ((n*(fack (n-1)))) in (fack (n ))))) - $ dune exec lambda_lifting_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) - (fun g(a c d)->(let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)))) - (fun f(a)->(let g = (let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)) in (g (a ) 2 3)))) - $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml - fac not exist - $ dune exec lambda_lifting_test < manytests/do_not_type/002if.ml - (fun main()->(if (true) then (1) else (false))) - $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml - f not exist - $ dune exec lambda_lifting_test < manytests/typed/001fac.ml - (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) - (fun main()->(let () = ((print_int (fac 4)) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/002fac.ml - (fun anon$1(n k p)->((k (p*n)))) - (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1 (n ) (k )))))) - (fun anon$1(print_int)->(print_int)) - (fun main()->(let () = ((print_int (fac_cps 4 (anon$1 ))) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml - (fun wrap(f)->(if ((1=1)) then ((f )) else ((f )))) - (fun a(a)->((print_int (a )))) - (fun b(b)->((print_int (b )))) - (fun c(c)->((print_int (c )))) - (fun test3(a b c)->(let a = ((print_int (a )) in let b = ((print_int (b )) in let c = ((print_int (c )) in 0))))) - (fun test10(a b c d e f g h i j)->(((((((((((a )+(b ))+(c ))+(d ))+(e ))+(f ))+(g ))+(h ))+(i ))+(j )))) - (fun temp0()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) - (fun temp1(temp0)->((print_int (temp0 )))) - (fun temp2()->((wrap (test3 ) 1 10 100))) - (fun main()->(let temp0 = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1 = ((print_int (temp0 )) in let temp2 = ((wrap (test3 ) 1 10 100) in 0))))) - $ dune exec lambda_lifting_test < manytests/typed/005fix.ml - (fun fix(f x)->((f (fix (f )) (x )))) - (fun fac(self n)->(if (((n )<=1)) then (1) else (((n )*(self ((n )-1)))))) - (fun main()->(let () = ((print_int (fix (fac ) 6)) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/006partial.ml - (fun anon$1(foo)->((foo+2))) - (fun anon$2(foo)->((foo*10))) - (fun foo(b)->(if ((b )) then ((anon$1 )) else ((anon$2 )))) - (fun foo(x)->((foo true (foo false (foo true (foo false (x ))))))) - (fun main()->(let () = ((print_int (foo 11)) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/006partial2.ml - (fun foo(a b c)->(let () = ((print_int (a )) in let () = ((print_int (b )) in let () = ((print_int (c )) in ((a )+((b )*(c )))))))) - (fun foo()->((foo 1))) - (fun foo(foo)->((foo (foo ) 2))) - (fun foo(foo)->((foo (foo ) 3))) - (fun main()->(let foo = ((foo 1) in let foo = ((foo (foo ) 2) in let foo = ((foo (foo ) 3) in let () = ((print_int (foo )) in 0)))))) - $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - (fun anon$2(c)->((print_int (c )))) - (fun anon$1(b)->(let () = ((print_int (b )) in (anon$2 )))) - (fun foo(a)->(let () = ((print_int (a )) in (anon$1 )))) - (fun main()->(let () = ((foo 4 8 9) in 0))) - $ dune exec lambda_lifting_test < manytests/typed/007order.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec lambda_lifting_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec lambda_lifting_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + (fun anon$1(n f x)->((x*(f (n ))))) + (fun fack(n f)->(if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))))) + (fun anon$2(x)->(x)) + (fun fac(n)->(let fack = (if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon$1 (n ) (f )))) in (fack (n ) (anon$2 ))))) + $ dune exec lambda_lifting_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + (fun fack(n)->(if ((n<1)) then (n) else ((n*(fack (n-1)))))) + (fun fac(n)->(let fack = (if ((n<1)) then (n) else ((n*(fack (n-1)))) in (fack (n ))))) + $ dune exec lambda_lifting_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) + (fun g(a c d)->(let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)))) + (fun f(a)->(let g = (let h = (((a )*((c )+((d )*(e )))) in (h (a ) (c ) (d ) 4)) in (g (a ) 2 3)))) + $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml + fac not exist + $ dune exec lambda_lifting_test < manytests/do_not_type/002if.ml + (fun main()->(if (true) then (1) else (false))) + $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml + f not exist + $ dune exec lambda_lifting_test < manytests/typed/001fac.ml + (fun fac(n)->(if ((n<=1)) then (1) else ((n*(fac (n-1)))))) + (fun main()->(let () = ((print_int (fac 4)) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/002fac.ml + (fun anon$1(n k p)->((k (p*n)))) + (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1 (n ) (k )))))) + (fun anon$1(print_int)->(print_int)) + (fun main()->(let () = ((print_int (fac_cps 4 (anon$1 ))) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/003fib.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml + (fun wrap(f)->(if ((1=1)) then ((f )) else ((f )))) + (fun a(a)->((print_int (a )))) + (fun b(b)->((print_int (b )))) + (fun c(c)->((print_int (c )))) + (fun test3(a b c)->(let a = ((print_int (a )) in let b = ((print_int (b )) in let c = ((print_int (c )) in 0))))) + (fun test10(a b c d e f g h i j)->(((((((((((a )+(b ))+(c ))+(d ))+(e ))+(f ))+(g ))+(h ))+(i ))+(j )))) + (fun temp0()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) + (fun temp1(temp0)->((print_int (temp0 )))) + (fun temp2()->((wrap (test3 ) 1 10 100))) + (fun main()->(let temp0 = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1 = ((print_int (temp0 )) in let temp2 = ((wrap (test3 ) 1 10 100) in 0))))) + $ dune exec lambda_lifting_test < manytests/typed/005fix.ml + (fun fix(f x)->((f (fix (f )) (x )))) + (fun fac(self n)->(if (((n )<=1)) then (1) else (((n )*(self ((n )-1)))))) + (fun main()->(let () = ((print_int (fix (fac ) 6)) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/006partial.ml + (fun anon$1(foo)->((foo+2))) + (fun anon$2(foo)->((foo*10))) + (fun foo(b)->(if ((b )) then ((anon$1 )) else ((anon$2 )))) + (fun foo(x)->((foo true (foo false (foo true (foo false (x ))))))) + (fun main()->(let () = ((print_int (foo 11)) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/006partial2.ml + (fun foo(a b c)->(let () = ((print_int (a )) in let () = ((print_int (b )) in let () = ((print_int (c )) in ((a )+((b )*(c )))))))) + (fun foo()->((foo 1))) + (fun foo(foo)->((foo (foo ) 2))) + (fun foo(foo)->((foo (foo ) 3))) + (fun main()->(let foo = ((foo 1) in let foo = ((foo (foo ) 2) in let foo = ((foo (foo ) 3) in let () = ((print_int (foo )) in 0)))))) + $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml + (fun anon$2(c)->((print_int (c )))) + (fun anon$1(b)->(let () = ((print_int (b )) in (anon$2 )))) + (fun foo(a)->(let () = ((print_int (a )) in (anon$1 )))) + (fun main()->(let () = ((foo 4 8 9) in 0))) + $ dune exec lambda_lifting_test < manytests/typed/007order.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/008ascription.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/015tuples.ml + : end_of_input + $ dune exec lambda_lifting_test < manytests/typed/016lists.ml + : end_of_input diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 06fb800cd..97be29e96 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -1,136 +1,136 @@ - $ dune exec parser_test << EOF - > let a = 3 - > EOF - (let a=3) - $ dune exec parser_test << EOF - > let () = 0 - > EOF - (let ()=0) - $ dune exec parser_test << EOF - > (fun a -> b) - > EOF - (fun a->b) - $ dune exec parser_test << EOF - > let rec a = b in (c) - > EOF - (let rec a=b in c) - $ dune exec parser_test << EOF - > if a then b else c - > EOF - if (a) then (b) else (c) - $ dune exec parser_test << EOF - > let a = - > let b = 1 in - > let c = b in - > c - > EOF - (let a=(let b=1 in (let c=b in c))) - $ dune exec parser_test << EOF - > true && (a + (f false (g 3 y)) = 3 || 2) - > EOF - (true&&(((a+(f->false->(g->3->y)))=3)||2)) - $ dune exec parser_test << EOF - > (a b 2 1+3 * b d (-2) (r f)) + 3 - > EOF - Error: : end_of_input - $ dune exec parser_test << EOF - > a b c - > EOF - (a->b->c) - $ dune exec parser_test << EOF - > (a + (f 2 x (g 3*z y)) * 3) - > EOF - (a+((f->2->x->((g->3)*(z->y)))*3)) - $ dune exec parser_test << EOF - > (a + f 2 x (g 3*z y) * 3) - > EOF - (a+(f->2->x->(((g->3)*(z->y))*3))) - $ dune exec parser_test << EOF - > a + 2 <= b * 3 - > EOF - ((a+2)<=(b*3)) - $ dune exec parser_test << EOF - > a < 2 && b = 3 - > EOF - ((a<2)&&(b=3)) - $ dune exec parser_test << EOF - > ((a b 2 1 + 3 * b d (-2) (r f)) + 3) - > EOF - (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) - $ dune exec parser_test << EOF - > let fac n = - > let rec fack n f = - > if n <= 1 - > then f 1 - > else fack (n - 1) (fun x -> x * f n) - > in - > fack n (fun x -> x) - > ;; - > EOF - (let fac n=(let rec fack n f=if ((n<=1)) then ((f->1)) else ((fack->(n-1)->(fun x->(x*(f->n))))) in (fack->n->(fun x->x)))) - $ dune exec parser_test << EOF - > let fac n = - > let rec fack n = if n < 1 then n else n * fack (n - 1) in - > fack n - > ;; - > EOF - (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*(fack->(n-1)))) in (fack->n))) - $ dune exec parser_test << EOF - > let x = fack n - > ;; - > EOF - (let x=(fack->n)) - $ dune exec parser_test << EOF - > f 1 + f 2 - > EOF - ((f->1)+(f->2)) - $ dune exec parser_test << EOF - > let rec fib n = - > if n<2 - > then n - > else (fib (n - 1) + fib (n - 2)) - > EOF - (let rec fib n=if ((n<2)) then (n) else ((fib->((n-1)+(fib->(n-2)))))) - $ dune exec parser_test < test/manytests/do_not_type/001.ml - (let recfac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) - $ dune exec parser_test < test/manytests/do_not_type/002if.ml - (let main=if (true) then (1) else (false)) - $ dune exec parser_test < test/manytests/do_not_type/003occurs.ml - (let fix f=(fun x->(f->(fun f->(x->x->f))))) - (fun x->(f->(fun f->(x->x->f)))) - $ dune exec parser_test < test/manytests/typed/001fac.ml - (let rec fac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) - (let main=(let ()=(print_int->(fac->4)) in 0)) - $ dune exec parser_test < test/manytests/typed/002fac.ml - (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))))) - (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) - $ dune exec parser_test < test/manytests/typed/003fib.ml - Error: : end_of_input - $ dune exec parser_test < test/manytests/typed/004manyargs.ml - (let wrap f=if ((1=1)) then (f) else (f)) - (let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0)))) - (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) - (let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0)))) - $ dune exec parser_test < test/manytests/typed/005fix.ml - (let rec fix f x=(f->(fix->f)->x)) - (let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1))))) - (let main=(let ()=(print_int->(fix->fac->6)) in 0)) - $ dune exec parser_test < test/manytests/typed/006partial.ml - (let foo b=if (b) then ((fun foo->(foo+2))) else ((fun foo->(foo*10)))) - (let foo x=(foo->true->(foo->false->(foo->true->(foo->false->x))))) - (let main=(let ()=(print_int->(foo->11)) in 0)) - $ dune exec parser_test < test/manytests/typed/006partial2.ml - (let foo a b c=(let ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(print_int->c) in (a+(b*c)))))) - (let main=(let foo=(foo->1) in (let foo=(foo->2) in (let foo=(foo->3) in (let ()=(print_int->foo) in 0))))) - $ dune exec parser_test < test/manytests/typed/006partial3.ml - (let foo a=(let ()=(print_int->a) in (fun b->(let ()=(print_int->b) in (fun c->(print_int->c)))))) - (let main=(let ()=(foo->4->8->9) in 0)) - $ dune exec parser_test < test/manytests/typed/007order.ml - Error: : end_of_input - $ dune exec parser_test < test/manytests/typed/008ascription.ml - Error: : end_of_input - $ dune exec parser_test < test/manytests/typed/015tuples.ml - Error: : end_of_input - $ dune exec parser_test < test/manytests/typed/016lists.ml - Error: : end_of_input - + $ dune exec parser_test << EOF + > let a = 3 + > EOF + (let a=3) + $ dune exec parser_test << EOF + > let () = 0 + > EOF + (let ()=0) + $ dune exec parser_test << EOF + > (fun a -> b) + > EOF + (fun a->b) + $ dune exec parser_test << EOF + > let rec a = b in (c) + > EOF + (let rec a=b in c) + $ dune exec parser_test << EOF + > if a then b else c + > EOF + if (a) then (b) else (c) + $ dune exec parser_test << EOF + > let a = + > let b = 1 in + > let c = b in + > c + > EOF + (let a=(let b=1 in (let c=b in c))) + $ dune exec parser_test << EOF + > true && (a + (f false (g 3 y)) = 3 || 2) + > EOF + (true&&(((a+(f->false->(g->3->y)))=3)||2)) + $ dune exec parser_test << EOF + > (a b 2 1+3 * b d (-2) (r f)) + 3 + > EOF + Error: : end_of_input + $ dune exec parser_test << EOF + > a b c + > EOF + (a->b->c) + $ dune exec parser_test << EOF + > (a + (f 2 x (g 3*z y)) * 3) + > EOF + (a+((f->2->x->((g->3)*(z->y)))*3)) + $ dune exec parser_test << EOF + > (a + f 2 x (g 3*z y) * 3) + > EOF + (a+(f->2->x->(((g->3)*(z->y))*3))) + $ dune exec parser_test << EOF + > a + 2 <= b * 3 + > EOF + ((a+2)<=(b*3)) + $ dune exec parser_test << EOF + > a < 2 && b = 3 + > EOF + ((a<2)&&(b=3)) + $ dune exec parser_test << EOF + > ((a b 2 1 + 3 * b d (-2) (r f)) + 3) + > EOF + (((a->b->2->1)+(3*(b->d->(-2)->(r->f))))+3) + $ dune exec parser_test << EOF + > let fac n = + > let rec fack n f = + > if n <= 1 + > then f 1 + > else fack (n - 1) (fun x -> x * f n) + > in + > fack n (fun x -> x) + > ;; + > EOF + (let fac n=(let rec fack n f=if ((n<=1)) then ((f->1)) else ((fack->(n-1)->(fun x->(x*(f->n))))) in (fack->n->(fun x->x)))) + $ dune exec parser_test << EOF + > let fac n = + > let rec fack n = if n < 1 then n else n * fack (n - 1) in + > fack n + > ;; + > EOF + (let fac n=(let rec fack n=if ((n<1)) then (n) else ((n*(fack->(n-1)))) in (fack->n))) + $ dune exec parser_test << EOF + > let x = fack n + > ;; + > EOF + (let x=(fack->n)) + $ dune exec parser_test << EOF + > f 1 + f 2 + > EOF + ((f->1)+(f->2)) + $ dune exec parser_test << EOF + > let rec fib n = + > if n<2 + > then n + > else (fib (n - 1) + fib (n - 2)) + > EOF + (let rec fib n=if ((n<2)) then (n) else ((fib->((n-1)+(fib->(n-2)))))) + $ dune exec parser_test < manytests/do_not_type/001.ml + (let recfac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) + $ dune exec parser_test < manytests/do_not_type/002if.ml + (let main=if (true) then (1) else (false)) + $ dune exec parser_test < manytests/do_not_type/003occurs.ml + (let fix f=(fun x->(f->(fun f->(x->x->f))))) + (fun x->(f->(fun f->(x->x->f)))) + $ dune exec parser_test < manytests/typed/001fac.ml + (let rec fac n=if ((n<=1)) then (1) else ((n*(fac->(n-1))))) + (let main=(let ()=(print_int->(fac->4)) in 0)) + $ dune exec parser_test < manytests/typed/002fac.ml + (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))))) + (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) + $ dune exec parser_test < manytests/typed/003fib.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/004manyargs.ml + (let wrap f=if ((1=1)) then (f) else (f)) + (let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0)))) + (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) + (let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0)))) + $ dune exec parser_test < manytests/typed/005fix.ml + (let rec fix f x=(f->(fix->f)->x)) + (let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1))))) + (let main=(let ()=(print_int->(fix->fac->6)) in 0)) + $ dune exec parser_test < manytests/typed/006partial.ml + (let foo b=if (b) then ((fun foo->(foo+2))) else ((fun foo->(foo*10)))) + (let foo x=(foo->true->(foo->false->(foo->true->(foo->false->x))))) + (let main=(let ()=(print_int->(foo->11)) in 0)) + $ dune exec parser_test < manytests/typed/006partial2.ml + (let foo a b c=(let ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(print_int->c) in (a+(b*c)))))) + (let main=(let foo=(foo->1) in (let foo=(foo->2) in (let foo=(foo->3) in (let ()=(print_int->foo) in 0))))) + $ dune exec parser_test < manytests/typed/006partial3.ml + (let foo a=(let ()=(print_int->a) in (fun b->(let ()=(print_int->b) in (fun c->(print_int->c)))))) + (let main=(let ()=(foo->4->8->9) in 0)) + $ dune exec parser_test < manytests/typed/007order.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/008ascription.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/015tuples.ml + Error: : end_of_input + $ dune exec parser_test < manytests/typed/016lists.ml + Error: : end_of_input + diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index cd44e72f8..eae8f03fb 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -1,1488 +1,1503 @@ - $ dune exec riscv64_instr_test << EOF - > let fac n = - > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in - > (fack n (fun x -> x)) - > ;; - > EOF - f not found - $ dune exec riscv64_instr_test << EOF - > let fac n = - > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in - > (fack n) - > ;; - > EOF - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - fack: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - li t0,1 - blt t0,a0,.tag_anf_op_1 - j .tag_anf_op_1_t - .tag_anf_op_1: - li t1,1 - sub t2,a0,t1 - sd t2,-24(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - ld t2,-88(s0) - mul t1,t2,a0 - sd a0,-32(s0) - mv a0,t1 - .tag_anf_op_1_t: - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - fac: - addi sp,sp,-192 - sd ra,176(sp) - sd s0,168(sp) - addi s0,sp,192 - sd a0,-184(s0) - li t0,1 - blt t0,a0,.tag_anf_op_6 - j .tag_anf_op_6_t - .tag_anf_op_6: - li t1,1 - sub t2,a0,t1 - sd t2,-24(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - ld t2,-184(s0) - mul t1,t2,a0 - sd a0,-32(s0) - mv a0,t1 - .tag_anf_op_6_t: - sd t1,-40(s0) - sd a0,-48(s0) - ld a0,-48(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-56(s0) - ld a0,-184(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-64(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,176(sp) - ld s0,168(sp) - addi sp,sp,192 - ret - $ dune exec riscv64_instr_test << EOF - > let f a = - > let g c d = - > let h e = a * (c + d * e) in - > (h 4) - > in - > (g 2 3) - > EOF - e not found - $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml - fac not exist - $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - addi s0,sp,32 - li t0,1 - beqz t0,.tag_if_bnch - li t1,1 - mv a0,t1 - j .tag_if_bnch_t - .tag_if_bnch: - li t2,0 - mv a0,t2 - .tag_if_bnch_t: - mv a0,a0 - ld ra,16(sp) - ld s0,8(sp) - addi sp,sp,32 - ret - $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml - f not exist - $ dune exec riscv64_instr_test < manytests/typed/001fac.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - fac: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - li t0,1 - ble t0,a0,.tag_anf_op_1 - li t1,1 - mv a0,t1 - j .tag_anf_op_1_t - .tag_anf_op_1: - ld a0,-88(s0) - li t2,1 - sub t3,a0,t2 - sd t3,-24(s0) - lui a0,%hi(fac) - addi a0,a0,%lo(fac) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - ld t3,-88(s0) - mul t2,t3,a0 - sd a0,-32(s0) - mv a0,t2 - .tag_anf_op_1_t: - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - main: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 - lui a0,%hi(fac) - addi a0,a0,%lo(fac) - li a3,4 - li a2,1 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 - ret - $ dune exec riscv64_instr_test < manytests/typed/002fac.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_1: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 - sd a2,-80(s0) - sd a1,-72(s0) - sd a0,-64(s0) - mul t0,a2,a0 - sd t0,-24(s0) - ld a0,-72(s0) - ld a3,-24(s0) - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - fac_cps: - addi sp,sp,-224 - sd ra,208(sp) - sd s0,200(sp) - addi s0,sp,224 - sd a1,-216(s0) - sd a0,-208(s0) - li t0,1 - beq a0,t0,.tag_anf_op_3 - ld a0,-216(s0) - li a3,1 - li a2,1 - li a1,0 - call part_app - j .tag_anf_op_3_t - .tag_anf_op_3: - ld t0,-208(s0) - li a1,1 - sub t1,t0,a1 - sd a0,-24(s0) - sd t1,-32(s0) - ld a0,-208(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-216(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-48(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - ld a4,-48(s0) - ld a3,-40(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-56(s0) - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - ld a4,-56(s0) - ld a3,-32(s0) - li a2,2 - li a1,2 - call part_app - .tag_anf_op_3_t: - sd a0,-64(s0) - mv a0,a0 - ld ra,208(sp) - ld s0,200(sp) - addi sp,sp,224 - ret - anon_1: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - addi s0,sp,32 - sd a0,-24(s0) - mv a0,a0 - ld ra,16(sp) - ld s0,8(sp) - addi sp,sp,32 - ret - main: - addi sp,sp,-144 - sd ra,136(sp) - sd s0,128(sp) - addi s0,sp,144 - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - li a2,0 - li a1,3 - call part_app - sd a0,-24(s0) - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - ld a4,-24(s0) - li a3,4 - li a2,2 - li a1,2 - call part_app - sd a0,-32(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-32(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-40(s0) - ld a0,-40(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,136(sp) - ld s0,128(sp) - addi sp,sp,144 - ret - $ dune exec riscv64_instr_test < manytests/typed/003fib.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - wrap: - addi sp,sp,-112 - sd ra,96(sp) - sd s0,88(sp) - addi s0,sp,112 - sd a0,-104(s0) - li t0,1 - li t1,1 - beq t0,t1,.tag_anf_op_1 - ld a0,-104(s0) - li a2,0 - li a1,0 - call part_app - j .tag_anf_op_1_t - .tag_anf_op_1: - sd a0,-24(s0) - ld a0,-104(s0) - li a2,0 - li a1,0 - call part_app - .tag_anf_op_1_t: - sd a0,-32(s0) - mv a0,a0 - ld ra,96(sp) - ld s0,88(sp) - addi sp,sp,112 - ret - a: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(a) - addi a0,a0,%lo(a) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - b: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(b) - addi a0,a0,%lo(b) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - c: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(c) - addi a0,a0,%lo(c) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - test3: - addi sp,sp,-336 - sd ra,320(sp) - sd s0,312(sp) - addi s0,sp,336 - sd a2,-328(s0) - sd a1,-320(s0) - sd a0,-312(s0) - lui a0,%hi(a) - addi a0,a0,%lo(a) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(b) - addi a0,a0,%lo(b) - li a2,0 - li a1,1 - call part_app - sd a0,-48(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-48(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-56(s0) - ld a0,-56(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - lui a0,%hi(c) - addi a0,a0,%lo(c) - li a2,0 - li a1,1 - call part_app - sd a0,-72(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-72(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-80(s0) - ld a0,-80(s0) - li a2,0 - li a1,0 - call part_app - li a1,0 - mv a0,a1 - ld ra,320(sp) - ld s0,312(sp) - addi sp,sp,336 - ret - test10: - addi sp,sp,-480 - sd ra,464(sp) - sd s0,456(sp) - addi s0,sp,480 - sd a7,-472(s0) - sd a6,-464(s0) - sd a5,-456(s0) - sd a4,-448(s0) - sd a3,-440(s0) - sd a2,-432(s0) - sd a1,-424(s0) - sd a0,-416(s0) - lui a0,%hi(a) - addi a0,a0,%lo(a) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(b) - addi a0,a0,%lo(b) - li a2,0 - li a1,1 - call part_app - ld a1,-24(s0) - add a2,a1,a0 - sd a0,-32(s0) - sd a2,-40(s0) - lui a0,%hi(c) - addi a0,a0,%lo(c) - li a2,0 - li a1,1 - call part_app - ld a2,-40(s0) - add a1,a2,a0 - sd a0,-48(s0) - sd a1,-56(s0) - ld a0,-440(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-56(s0) - add a2,a1,a0 - sd a0,-64(s0) - sd a2,-72(s0) - ld a0,-448(s0) - li a2,0 - li a1,0 - call part_app - ld a2,-72(s0) - add a1,a2,a0 - sd a0,-80(s0) - sd a1,-88(s0) - ld a0,-456(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-88(s0) - add a2,a1,a0 - sd a0,-96(s0) - sd a2,-104(s0) - ld a0,-464(s0) - li a2,0 - li a1,0 - call part_app - ld a2,-104(s0) - add a1,a2,a0 - sd a0,-112(s0) - sd a1,-120(s0) - ld a0,-472(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-120(s0) - add a2,a1,a0 - sd a0,-128(s0) - sd a2,-136(s0) - ld a0,0(s0) - li a2,0 - li a1,0 - call part_app - ld a2,-136(s0) - add a1,a2,a0 - sd a0,-144(s0) - sd a1,-152(s0) - ld a0,8(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-152(s0) - add a2,a1,a0 - mv a0,a2 - ld ra,464(sp) - ld s0,456(sp) - addi sp,sp,480 - ret - temp0: - addi sp,sp,-112 - sd ra,96(sp) - sd s0,88(sp) - addi s0,sp,112 - lui a0,%hi(test10) - addi a0,a0,%lo(test10) - li a2,0 - li a1,10 - call part_app - sd a0,-24(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li t6,10000 - sd t6,0(sp) - li t6,100000 - sd t6,8(sp) - li t6,1000000 - sd t6,16(sp) - li t6,10000000 - sd t6,24(sp) - li t6,100000000 - sd t6,32(sp) - li t6,1000000000 - sd t6,40(sp) - li a7,1000 - li a6,100 - li a5,10 - li a4,1 - ld a3,-24(s0) - li a2,11 - li a1,1 - call part_app - mv a0,a0 - ld ra,96(sp) - ld s0,88(sp) - addi sp,sp,112 - ret - temp1: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(temp0) - addi a0,a0,%lo(temp0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - temp2: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 - lui a0,%hi(test3) - addi a0,a0,%lo(test3) - li a2,0 - li a1,3 - call part_app - sd a0,-24(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li a6,100 - li a5,10 - li a4,1 - ld a3,-24(s0) - li a2,4 - li a1,1 - call part_app - mv a0,a0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - main: - addi sp,sp,-336 - sd ra,320(sp) - sd s0,312(sp) - addi s0,sp,336 - lui a0,%hi(test10) - addi a0,a0,%lo(test10) - li a2,0 - li a1,10 - call part_app - sd a0,-24(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li t6,10000 - sd t6,0(sp) - li t6,100000 - sd t6,8(sp) - li t6,1000000 - sd t6,16(sp) - li t6,10000000 - sd t6,24(sp) - li t6,100000000 - sd t6,32(sp) - li t6,1000000000 - sd t6,40(sp) - li a7,1000 - li a6,100 - li a5,10 - li a4,1 - ld a3,-24(s0) - li a2,11 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(temp0) - addi a0,a0,%lo(temp0) - li a2,0 - li a1,0 - call part_app - sd a0,-48(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-48(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-56(s0) - ld a0,-56(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - lui a0,%hi(test3) - addi a0,a0,%lo(test3) - li a2,0 - li a1,3 - call part_app - sd a0,-72(s0) - lui a0,%hi(wrap) - addi a0,a0,%lo(wrap) - li a6,100 - li a5,10 - li a4,1 - ld a3,-72(s0) - li a2,4 - li a1,1 - call part_app - sd a0,-80(s0) - ld a0,-80(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,320(sp) - ld s0,312(sp) - addi sp,sp,336 - ret - $ dune exec riscv64_instr_test < manytests/typed/005fix.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - fix: - addi sp,sp,-160 - sd ra,152(sp) - sd s0,144(sp) - addi s0,sp,160 - sd a1,-160(s0) - sd a0,-152(s0) - ld a0,-152(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(fix) - addi a0,a0,%lo(fix) - ld a3,-24(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-32(s0) - ld a0,-160(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-152(s0) - ld a4,-40(s0) - ld a3,-32(s0) - li a2,2 - li a1,0 - call part_app - mv a0,a0 - ld ra,152(sp) - ld s0,144(sp) - addi sp,sp,160 - ret - fac: - addi sp,sp,-192 - sd ra,184(sp) - sd s0,176(sp) - addi s0,sp,192 - sd a1,-192(s0) - sd a0,-184(s0) - ld a0,-192(s0) - li a2,0 - li a1,0 - call part_app - li a1,1 - ble a1,a0,.tag_anf_op_6 - li t0,1 - sd a0,-24(s0) - mv a0,t0 - j .tag_anf_op_6_t - .tag_anf_op_6: - ld a0,-192(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-32(s0) - ld a0,-192(s0) - li a2,0 - li a1,0 - call part_app - li t0,1 - sub a1,a0,t0 - sd a0,-40(s0) - sd a1,-48(s0) - ld a0,-184(s0) - ld a3,-48(s0) - li a2,1 - li a1,0 - call part_app - ld a1,-32(s0) - mul t0,a1,a0 - sd a0,-56(s0) - mv a0,t0 - .tag_anf_op_6_t: - mv a0,a0 - ld ra,184(sp) - ld s0,176(sp) - addi sp,sp,192 - ret - main: - addi sp,sp,-144 - sd ra,136(sp) - sd s0,128(sp) - addi s0,sp,144 - lui a0,%hi(fac) - addi a0,a0,%lo(fac) - li a2,0 - li a1,2 - call part_app - sd a0,-24(s0) - lui a0,%hi(fix) - addi a0,a0,%lo(fix) - li a4,6 - ld a3,-24(s0) - li a2,2 - li a1,2 - call part_app - sd a0,-32(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-32(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-40(s0) - ld a0,-40(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,136(sp) - ld s0,128(sp) - addi sp,sp,144 - ret - $ dune exec riscv64_instr_test < manytests/typed/006partial.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_1: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - sd a0,-32(s0) - li t0,2 - add t1,a0,t0 - mv a0,t1 - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 - ret - anon_2: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - sd a0,-32(s0) - li t0,10 - mul t1,a0,t0 - mv a0,t1 - ld ra,24(sp) - ld s0,16(sp) - addi sp,sp,32 - ret - foo: - addi sp,sp,-128 - sd ra,120(sp) - sd s0,112(sp) - addi s0,sp,128 - sd a0,-128(s0) - ld a0,-128(s0) - li a2,0 - li a1,0 - call part_app - beqz a0,.tag_if_bnch - sd a0,-24(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - li a2,0 - li a1,1 - call part_app - j .tag_if_bnch_t - .tag_if_bnch: - sd a0,-32(s0) - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - li a2,0 - li a1,1 - call part_app - .tag_if_bnch_t: - sd a0,-40(s0) - mv a0,a0 - ld ra,120(sp) - ld s0,112(sp) - addi sp,sp,128 - ret - foo: - addi sp,sp,-192 - sd ra,176(sp) - sd s0,168(sp) - addi s0,sp,192 - sd a0,-184(s0) - ld a0,-184(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-24(s0) - li a3,0 - li a2,2 - li a1,1 - call part_app - sd a0,-32(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-32(s0) - li a3,1 - li a2,2 - li a1,1 - call part_app - sd a0,-40(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-40(s0) - li a3,0 - li a2,2 - li a1,1 - call part_app - sd a0,-48(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-48(s0) - li a3,1 - li a2,2 - li a1,1 - call part_app - mv a0,a0 - ld ra,176(sp) - ld s0,168(sp) - addi sp,sp,192 - ret - main: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,11 - li a2,1 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 - ret - $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - foo: - addi sp,sp,-448 - sd ra,432(sp) - sd s0,424(sp) - addi s0,sp,448 - sd a2,-440(s0) - sd a1,-432(s0) - sd a0,-424(s0) - ld a0,-424(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-432(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-48(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-48(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-56(s0) - ld a0,-56(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-64(s0) - ld a0,-440(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-72(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-72(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-80(s0) - ld a0,-80(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-88(s0) - ld a0,-424(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-96(s0) - ld a0,-432(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-104(s0) - ld a0,-440(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-104(s0) - mul a2,a1,a0 - ld t0,-96(s0) - add t1,t0,a2 - mv a0,t1 - ld ra,432(sp) - ld s0,424(sp) - addi sp,sp,448 - ret - foo: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,1 - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,40(sp) - ld s0,32(sp) - addi sp,sp,48 - ret - foo: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,2 - ld a3,-24(s0) - li a2,2 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - foo: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,1 - call part_app - sd a0,-24(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,3 - ld a3,-24(s0) - li a2,2 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - main: - addi sp,sp,-368 - sd ra,360(sp) - sd s0,352(sp) - addi s0,sp,368 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,1 - li a2,1 - li a1,3 - call part_app - sd a0,-24(s0) - ld a0,-24(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-32(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,3 - call part_app - sd a0,-40(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,2 - ld a3,-40(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-48(s0) - ld a0,-48(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-56(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,3 - call part_app - sd a0,-64(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a4,3 - ld a3,-64(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-72(s0) - ld a0,-72(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-80(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a2,0 - li a1,3 - call part_app - sd a0,-88(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-88(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-96(s0) - ld a0,-96(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,360(sp) - ld s0,352(sp) - addi sp,sp,368 - ret - $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-24 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,24 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,24 - li a7,93 - ecall - anon_2: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - ld a0,-88(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - anon_1: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a0,-152(s0) - ld a0,-152(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - li a2,0 - li a1,1 - call part_app - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - foo: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a0,-152(s0) - ld a0,-152(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - li a2,0 - li a1,1 - call part_app - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - main: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a5,9 - li a4,8 - li a3,4 - li a2,3 - li a1,1 - call part_app - sd a0,-24(s0) - ld a0,-24(s0) - li a2,0 - li a1,0 - call part_app - li t0,0 - mv a0,t0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 - ret - $ dune exec riscv64_instr_test < manytests/typed/007order.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/008ascription.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/015tuples.ml - : end_of_input - $ dune exec riscv64_instr_test < manytests/typed/016lists.ml - : end_of_input + $ dune exec riscv64_instr_test << EOF + > let fac n = + > let rec fack n f = if (n <= 1) then (f 1) else (fack (n - 1) (fun x -> x * (f n))) in + > (fack n (fun x -> x)) + > ;; + > EOF + f not found + $ dune exec riscv64_instr_test << EOF + > let fac n = + > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in + > (fack n) + > ;; + > EOF + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fack: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + li t0,1 + blt t0,a0,.tag_anf_op_1 + j .tag_anf_op_1_t + .tag_anf_op_1: + li t1,1 + sub t2,a0,t1 + sd t2,-24(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t2,-88(s0) + mul t1,t2,a0 + sd a0,-32(s0) + mv a0,t1 + .tag_anf_op_1_t: + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + fac: + addi sp,sp,-192 + sd ra,176(sp) + sd s0,168(sp) + addi s0,sp,192 + sd a0,-184(s0) + li t0,1 + blt t0,a0,.tag_anf_op_6 + j .tag_anf_op_6_t + .tag_anf_op_6: + li t1,1 + sub t2,a0,t1 + sd t2,-24(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t2,-184(s0) + mul t1,t2,a0 + sd a0,-32(s0) + mv a0,t1 + .tag_anf_op_6_t: + sd t1,-40(s0) + sd a0,-48(s0) + ld a0,-48(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-56(s0) + ld a0,-184(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-64(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 + ret + $ dune exec riscv64_instr_test << EOF + > let f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + e not found + $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml + fac not exist + + $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + addi s0,sp,32 + li t0,1 + beqz t0,.tag_if_bnch + li t1,1 + mv a0,t1 + j .tag_if_bnch_t + .tag_if_bnch: + li t2,0 + mv a0,t2 + .tag_if_bnch_t: + mv a0,a0 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 + ret + + $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml + f not exist + + $ dune exec riscv64_instr_test < manytests/typed/001fac.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fac: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + li t0,1 + ble t0,a0,.tag_anf_op_1 + li t1,1 + mv a0,t1 + j .tag_anf_op_1_t + .tag_anf_op_1: + ld a0,-88(s0) + li t2,1 + sub t3,a0,t2 + sd t3,-24(s0) + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + ld t3,-88(s0) + mul t2,t3,a0 + sd a0,-32(s0) + mv a0,t2 + .tag_anf_op_1_t: + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a3,4 + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + + $ dune exec riscv64_instr_test < manytests/typed/002fac.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) + mul t0,a2,a0 + sd t0,-24(s0) + ld a0,-72(s0) + ld a3,-24(s0) + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + fac_cps: + addi sp,sp,-224 + sd ra,208(sp) + sd s0,200(sp) + addi s0,sp,224 + sd a1,-216(s0) + sd a0,-208(s0) + li t0,1 + beq a0,t0,.tag_anf_op_3 + ld a0,-216(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + j .tag_anf_op_3_t + .tag_anf_op_3: + ld t0,-208(s0) + li a1,1 + sub t1,t0,a1 + sd a0,-24(s0) + sd t1,-32(s0) + ld a0,-208(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-216(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a4,-48(s0) + ld a3,-40(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-56(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-56(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + .tag_anf_op_3_t: + sd a0,-64(s0) + mv a0,a0 + ld ra,208(sp) + ld s0,200(sp) + addi sp,sp,224 + ret + anon_1: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + addi s0,sp,32 + sd a0,-24(s0) + mv a0,a0 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 + ret + main: + addi sp,sp,-144 + sd ra,136(sp) + sd s0,128(sp) + addi s0,sp,144 + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + li a2,0 + li a1,3 + call part_app + sd a0,-24(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-24(s0) + li a3,4 + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,136(sp) + ld s0,128(sp) + addi sp,sp,144 + ret + + $ dune exec riscv64_instr_test < manytests/typed/003fib.ml + : end_of_input + + $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + wrap: + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + sd a0,-104(s0) + li t0,1 + li t1,1 + beq t0,t1,.tag_anf_op_1 + ld a0,-104(s0) + li a2,0 + li a1,0 + call part_app + j .tag_anf_op_1_t + .tag_anf_op_1: + sd a0,-24(s0) + ld a0,-104(s0) + li a2,0 + li a1,0 + call part_app + .tag_anf_op_1_t: + sd a0,-32(s0) + mv a0,a0 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 + ret + a: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + b: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + c: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + test3: + addi sp,sp,-336 + sd ra,320(sp) + sd s0,312(sp) + addi s0,sp,336 + sd a2,-328(s0) + sd a1,-320(s0) + sd a0,-312(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 + li a1,1 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + sd a0,-72(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-72(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + li a1,0 + mv a0,a1 + ld ra,320(sp) + ld s0,312(sp) + addi sp,sp,336 + ret + test10: + addi sp,sp,-480 + sd ra,464(sp) + sd s0,456(sp) + addi s0,sp,480 + sd a7,-472(s0) + sd a6,-464(s0) + sd a5,-456(s0) + sd a4,-448(s0) + sd a3,-440(s0) + sd a2,-432(s0) + sd a1,-424(s0) + sd a0,-416(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(b) + addi a0,a0,%lo(b) + li a2,0 + li a1,1 + call part_app + ld a1,-24(s0) + add a2,a1,a0 + sd a0,-32(s0) + sd a2,-40(s0) + lui a0,%hi(c) + addi a0,a0,%lo(c) + li a2,0 + li a1,1 + call part_app + ld a2,-40(s0) + add a1,a2,a0 + sd a0,-48(s0) + sd a1,-56(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-56(s0) + add a2,a1,a0 + sd a0,-64(s0) + sd a2,-72(s0) + ld a0,-448(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-72(s0) + add a1,a2,a0 + sd a0,-80(s0) + sd a1,-88(s0) + ld a0,-456(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-88(s0) + add a2,a1,a0 + sd a0,-96(s0) + sd a2,-104(s0) + ld a0,-464(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-104(s0) + add a1,a2,a0 + sd a0,-112(s0) + sd a1,-120(s0) + ld a0,-472(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-120(s0) + add a2,a1,a0 + sd a0,-128(s0) + sd a2,-136(s0) + ld a0,0(s0) + li a2,0 + li a1,0 + call part_app + ld a2,-136(s0) + add a1,a2,a0 + sd a0,-144(s0) + sd a1,-152(s0) + ld a0,8(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-152(s0) + add a2,a1,a0 + mv a0,a2 + ld ra,464(sp) + ld s0,456(sp) + addi sp,sp,480 + ret + temp0: + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + lui a0,%hi(test10) + addi a0,a0,%lo(test10) + li a2,0 + li a1,10 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li t6,10000 + sd t6,0(sp) + li t6,100000 + sd t6,8(sp) + li t6,1000000 + sd t6,16(sp) + li t6,10000000 + sd t6,24(sp) + li t6,100000000 + sd t6,32(sp) + li t6,1000000000 + sd t6,40(sp) + li a7,1000 + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,11 + li a1,1 + call part_app + mv a0,a0 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 + ret + temp1: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(temp0) + addi a0,a0,%lo(temp0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + temp2: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a2,0 + li a1,3 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,4 + li a1,1 + call part_app + mv a0,a0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + main: + addi sp,sp,-336 + sd ra,320(sp) + sd s0,312(sp) + addi s0,sp,336 + lui a0,%hi(test10) + addi a0,a0,%lo(test10) + li a2,0 + li a1,10 + call part_app + sd a0,-24(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li t6,10000 + sd t6,0(sp) + li t6,100000 + sd t6,8(sp) + li t6,1000000 + sd t6,16(sp) + li t6,10000000 + sd t6,24(sp) + li t6,100000000 + sd t6,32(sp) + li t6,1000000000 + sd t6,40(sp) + li a7,1000 + li a6,100 + li a5,10 + li a4,1 + ld a3,-24(s0) + li a2,11 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(temp0) + addi a0,a0,%lo(temp0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a2,0 + li a1,3 + call part_app + sd a0,-72(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + li a6,100 + li a5,10 + li a4,1 + ld a3,-72(s0) + li a2,4 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,320(sp) + ld s0,312(sp) + addi sp,sp,336 + ret + + $ dune exec riscv64_instr_test < manytests/typed/005fix.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + fix: + addi sp,sp,-160 + sd ra,152(sp) + sd s0,144(sp) + addi s0,sp,160 + sd a1,-160(s0) + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + ld a3,-24(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + ld a0,-160(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-152(s0) + ld a4,-40(s0) + ld a3,-32(s0) + li a2,2 + li a1,0 + call part_app + mv a0,a0 + ld ra,152(sp) + ld s0,144(sp) + addi sp,sp,160 + ret + fac: + addi sp,sp,-192 + sd ra,184(sp) + sd s0,176(sp) + addi s0,sp,192 + sd a1,-192(s0) + sd a0,-184(s0) + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + li a1,1 + ble a1,a0,.tag_anf_op_6 + li t0,1 + sd a0,-24(s0) + mv a0,t0 + j .tag_anf_op_6_t + .tag_anf_op_6: + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) + ld a0,-192(s0) + li a2,0 + li a1,0 + call part_app + li t0,1 + sub a1,a0,t0 + sd a0,-40(s0) + sd a1,-48(s0) + ld a0,-184(s0) + ld a3,-48(s0) + li a2,1 + li a1,0 + call part_app + ld a1,-32(s0) + mul t0,a1,a0 + sd a0,-56(s0) + mv a0,t0 + .tag_anf_op_6_t: + mv a0,a0 + ld ra,184(sp) + ld s0,176(sp) + addi sp,sp,192 + ret + main: + addi sp,sp,-144 + sd ra,136(sp) + sd s0,128(sp) + addi s0,sp,144 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a2,0 + li a1,2 + call part_app + sd a0,-24(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + li a4,6 + ld a3,-24(s0) + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,136(sp) + ld s0,128(sp) + addi sp,sp,144 + ret + + $ dune exec riscv64_instr_test < manytests/typed/006partial.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_1: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,2 + add t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + anon_2: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,10 + mul t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + foo: + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a0,-128(s0) + ld a0,-128(s0) + li a2,0 + li a1,0 + call part_app + beqz a0,.tag_if_bnch + sd a0,-24(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + li a2,0 + li a1,1 + call part_app + j .tag_if_bnch_t + .tag_if_bnch: + sd a0,-32(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + li a2,0 + li a1,1 + call part_app + .tag_if_bnch_t: + sd a0,-40(s0) + mv a0,a0 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 + ret + foo: + addi sp,sp,-192 + sd ra,176(sp) + sd s0,168(sp) + addi s0,sp,192 + sd a0,-184(s0) + ld a0,-184(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-24(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-32(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-32(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + sd a0,-40(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-40(s0) + li a3,0 + li a2,2 + li a1,1 + call part_app + sd a0,-48(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + ld a4,-48(s0) + li a3,1 + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 + ret + main: + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,11 + li a2,1 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + + $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + foo: + addi sp,sp,-448 + sd ra,432(sp) + sd s0,424(sp) + addi s0,sp,448 + sd a2,-440(s0) + sd a1,-432(s0) + sd a0,-424(s0) + ld a0,-424(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-432(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-64(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-72(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-72(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-88(s0) + ld a0,-424(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-96(s0) + ld a0,-432(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-104(s0) + ld a0,-440(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-104(s0) + mul a2,a1,a0 + ld t0,-96(s0) + add t1,t0,a2 + mv a0,t1 + ld ra,432(sp) + ld s0,424(sp) + addi sp,sp,448 + ret + foo: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,1 + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret + foo: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,2 + ld a3,-24(s0) + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + foo: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,1 + call part_app + sd a0,-24(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,3 + ld a3,-24(s0) + li a2,2 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + main: + addi sp,sp,-368 + sd ra,360(sp) + sd s0,352(sp) + addi s0,sp,368 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a3,1 + li a2,1 + li a1,3 + call part_app + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-40(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,2 + ld a3,-40(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-56(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-64(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a4,3 + ld a3,-64(s0) + li a2,2 + li a1,3 + call part_app + sd a0,-72(s0) + ld a0,-72(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-80(s0) + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a2,0 + li a1,3 + call part_app + sd a0,-88(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-88(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-96(s0) + ld a0,-96(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,360(sp) + ld s0,352(sp) + addi sp,sp,368 + ret + + $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + anon_2: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + ld a0,-88(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + anon_1: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + li a2,0 + li a1,1 + call part_app + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + foo: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a0,-152(s0) + ld a0,-152(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + li a2,0 + li a1,1 + call part_app + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + main: + addi sp,sp,-80 + sd ra,72(sp) + sd s0,64(sp) + addi s0,sp,80 + lui a0,%hi(foo) + addi a0,a0,%lo(foo) + li a5,9 + li a4,8 + li a3,4 + li a2,3 + li a1,1 + call part_app + sd a0,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 + ret + + $ dune exec riscv64_instr_test < manytests/typed/007order.ml + : end_of_input + + $ dune exec riscv64_instr_test < manytests/typed/008ascription.ml + : end_of_input + + $ dune exec riscv64_instr_test < manytests/typed/015tuples.ml + : end_of_input + + $ dune exec riscv64_instr_test < manytests/typed/016lists.ml + : end_of_input + From dc4733a450b13598198e8f3506efcfb77363688e Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Fri, 21 Mar 2025 08:08:19 +0300 Subject: [PATCH 21/24] Promote new tests --- slarnML/.gitignore | 2 + slarnML/test/anf_conv_test.t | 107 +++++++++++--- slarnML/test/clos_conv_test.t | 6 +- slarnML/test/lambda_lifting_test.t | 11 +- slarnML/test/parser_tests.t | 6 +- slarnML/test/riscv64_instr_test.t | 224 +++++++++++++++++++++++++---- 6 files changed, 300 insertions(+), 56 deletions(-) diff --git a/slarnML/.gitignore b/slarnML/.gitignore index 9be1d8541..732fd0fcc 100644 --- a/slarnML/.gitignore +++ b/slarnML/.gitignore @@ -5,3 +5,5 @@ trash *.o *.out demo/main.S +test/manytests +test/manytests_ \ No newline at end of file diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index dc51a7531..9b20f5e67 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -288,7 +288,79 @@ 0)))) ) $ dune exec anf_conv_test < manytests/typed/003fib.ml - : end_of_input + (fun n1(n)-> + (let anf_op#1=(n-1) + in + anf_op#1) + ) + (fun ab(a b)-> + (let anf_op#2=(a+b) + in + anf_op#2) + ) + (fun fib_acc(a b n)-> + (let anf_op#3=(n=1) + in + (let anf_if#4=if (anf_op#3) + then ( + b + ) else ( + (let anf_op#5=(n-1) + in + (let anf_n1#6=(anf_op#5 ) + in + (let anf_op#7=(a+b) + in + (let anf_ab#8=(anf_op#7 ) + in + (let anf_app#9=(b ) + in + (let anf_app#10=(ab ) + in + (let anf_app#11=(n1 ) + in + (let anf_app#12=(fib_acc anf_app#9 anf_app#10 anf_app#11) + in + anf_app#12))))))))) + in + anf_if#4)) + ) + (fun fib(n)-> + (let anf_op#13=(n<2) + in + (let anf_if#14=if (anf_op#13) + then ( + n + ) else ( + (let anf_op#15=(n-1) + in + (let anf_op#16=(n-2) + in + (let anf_app#17=(fib anf_op#16) + in + (let anf_op#18=(anf_op#15+anf_app#17) + in + (let anf_app#19=(fib anf_op#18) + in + anf_app#19)))))) + in + anf_if#14)) + ) + (fun main()-> + (let anf_app#20=(fib_acc 0 1 4) + in + (let anf_app#21=(print_int anf_app#20) + in + (let anf_()#22=(anf_app#21 ) + in + (let anf_app#23=(fib 4) + in + (let anf_app#24=(print_int anf_app#23) + in + (let anf_()#25=(anf_app#24 ) + in + 0)))))) + ) $ dune exec anf_conv_test < manytests/typed/004manyargs.ml (fun wrap(f)-> (let anf_op#1=(1=1) @@ -388,45 +460,38 @@ in anf_op#38))))))))))))))))))) ) - (fun temp0()-> + (fun rez()-> (let anf_app#39=(test10 ) in (let anf_app#40=(wrap anf_app#39 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in anf_app#40)) ) - (fun temp1(temp0)-> - (let anf_app#41=(temp0 ) - in - (let anf_app#42=(print_int anf_app#41) - in - anf_app#42)) - ) (fun temp2()-> - (let anf_app#43=(test3 ) + (let anf_app#41=(test3 ) in - (let anf_app#44=(wrap anf_app#43 1 10 100) + (let anf_app#42=(wrap anf_app#41 1 10 100) in - anf_app#44)) + anf_app#42)) ) (fun main()-> - (let anf_app#45=(test10 ) + (let anf_app#43=(test10 ) in - (let anf_app#46=(wrap anf_app#45 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#44=(wrap anf_app#43 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - (let anf_temp0#47=(anf_app#46 ) + (let anf_rez#45=(anf_app#44 ) in - (let anf_app#48=(temp0 ) + (let anf_app#46=(rez ) in - (let anf_app#49=(print_int anf_app#48) + (let anf_app#47=(print_int anf_app#46) in - (let anf_temp1#50=(anf_app#49 ) + (let anf_()#48=(anf_app#47 ) in - (let anf_app#51=(test3 ) + (let anf_app#49=(test3 ) in - (let anf_app#52=(wrap anf_app#51 1 10 100) + (let anf_app#50=(wrap anf_app#49 1 10 100) in - (let anf_temp2#53=(anf_app#52 ) + (let anf_temp2#51=(anf_app#50 ) in 0))))))))) ) diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index c9269e017..33f32d132 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -37,12 +37,14 @@ (let rec fac_cps n k=if ((n=1)) then (((k ) 1)) else (((fac_cps ) (n-1) ((fun n k p->((k ) (p*n))) n k)))) (let main=(let ()=((print_int ) ((fac_cps ) 4 ((fun print_int->print_int) ))) in 0)) $ dune exec clos_conv_test < manytests/typed/003fib.ml - : end_of_input + (let rec fib_acc a b n=if ((n=1)) then (b) else ((let n1 n=(n-1) in (let ab a b=(a+b) in ((fib_acc ) b ab n1))))) + (let rec fib n=if ((n<2)) then (n) else (((fib ) ((n-1)+((fib ) (n-2)))))) + (let main=(let ()=((print_int ) ((fib_acc ) 0 1 4)) in (let ()=((print_int ) ((fib ) 4)) in 0))) $ dune exec clos_conv_test < manytests/typed/004manyargs.ml (let wrap f=if ((1=1)) then (f) else (f)) (let test3 a b c=(let a a=((print_int ) a) in (let b b=((print_int ) b) in (let c c=((print_int ) c) in 0)))) (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) - (let main=(let temp0=((wrap ) test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let temp1 temp0=((print_int ) temp0) in (let temp2=((wrap ) test3 1 10 100) in 0)))) + (let main=(let rez=((wrap ) test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let ()=((print_int ) rez) in (let temp2=((wrap ) test3 1 10 100) in 0)))) $ dune exec clos_conv_test < manytests/typed/005fix.ml (let rec fix f x=((f ) ((fix ) f) x)) (let fac self n=if ((n<=1)) then (1) else ((n*((self ) (n-1))))) diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 4f4150adb..ed04be25b 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -42,7 +42,11 @@ (fun anon$1(print_int)->(print_int)) (fun main()->(let () = ((print_int (fac_cps 4 (anon$1 ))) in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml - : end_of_input + (fun n1(n)->((n-1))) + (fun ab(a b)->((a+b))) + (fun fib_acc(a b n)->(if ((n=1)) then (b) else (let n1 = ((n-1) in let ab = ((a+b) in (fib_acc (b ) (ab ) (n1 ))))))) + (fun fib(n)->(if ((n<2)) then (n) else ((fib ((n-1)+(fib (n-2))))))) + (fun main()->(let () = ((print_int (fib_acc 0 1 4)) in let () = ((print_int (fib 4)) in 0)))) $ dune exec lambda_lifting_test < manytests/typed/004manyargs.ml (fun wrap(f)->(if ((1=1)) then ((f )) else ((f )))) (fun a(a)->((print_int (a )))) @@ -50,10 +54,9 @@ (fun c(c)->((print_int (c )))) (fun test3(a b c)->(let a = ((print_int (a )) in let b = ((print_int (b )) in let c = ((print_int (c )) in 0))))) (fun test10(a b c d e f g h i j)->(((((((((((a )+(b ))+(c ))+(d ))+(e ))+(f ))+(g ))+(h ))+(i ))+(j )))) - (fun temp0()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) - (fun temp1(temp0)->((print_int (temp0 )))) + (fun rez()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) (fun temp2()->((wrap (test3 ) 1 10 100))) - (fun main()->(let temp0 = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let temp1 = ((print_int (temp0 )) in let temp2 = ((wrap (test3 ) 1 10 100) in 0))))) + (fun main()->(let rez = ((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in let () = ((print_int (rez )) in let temp2 = ((wrap (test3 ) 1 10 100) in 0))))) $ dune exec lambda_lifting_test < manytests/typed/005fix.ml (fun fix(f x)->((f (fix (f )) (x )))) (fun fac(self n)->(if (((n )<=1)) then (1) else (((n )*(self ((n )-1)))))) diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 97be29e96..37f7923f8 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -105,12 +105,14 @@ (let rec fac_cps n k=if ((n=1)) then ((k->1)) else ((fac_cps->(n-1)->(fun p->(k->(p*n)))))) (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) $ dune exec parser_test < manytests/typed/003fib.ml - Error: : end_of_input + (let rec fib_acc a b n=if ((n=1)) then (b) else ((let n1=(n-1) in (let ab=(a+b) in (fib_acc->b->ab->n1))))) + (let rec fib n=if ((n<2)) then (n) else ((fib->((n-1)+(fib->(n-2)))))) + (let main=(let ()=(print_int->(fib_acc->0->1->4)) in (let ()=(print_int->(fib->4)) in 0))) $ dune exec parser_test < manytests/typed/004manyargs.ml (let wrap f=if ((1=1)) then (f) else (f)) (let test3 a b c=(let a=(print_int->a) in (let b=(print_int->b) in (let c=(print_int->c) in 0)))) (let test10 a b c d e f g h i j=(((((((((a+b)+c)+d)+e)+f)+g)+h)+i)+j)) - (let main=(let temp0=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let temp1=(print_int->temp0) in (let temp2=(wrap->test3->1->10->100) in 0)))) + (let main=(let rez=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let ()=(print_int->rez) in (let temp2=(wrap->test3->1->10->100) in 0)))) $ dune exec parser_test < manytests/typed/005fix.ml (let rec fix f x=(f->(fix->f)->x)) (let fac self n=if ((n<=1)) then (1) else ((n*(self->(n-1))))) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index eae8f03fb..20345adae 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -377,7 +377,200 @@ ret $ dune exec riscv64_instr_test < manytests/typed/003fib.ml - : end_of_input + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global _start + _start: + addi sp,sp,-24 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,24 + call init_part_apps + call main + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,24 + li a7,93 + ecall + n1: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a0,-32(s0) + li t0,1 + sub t1,a0,t0 + mv a0,t1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + ab: + addi sp,sp,-48 + sd ra,32(sp) + sd s0,24(sp) + addi s0,sp,48 + sd a1,-40(s0) + sd a0,-32(s0) + add t0,a0,a1 + mv a0,t0 + ld ra,32(sp) + ld s0,24(sp) + addi sp,sp,48 + ret + fib_acc: + addi sp,sp,-272 + sd ra,256(sp) + sd s0,248(sp) + addi s0,sp,272 + sd a2,-264(s0) + sd a1,-256(s0) + sd a0,-248(s0) + li t0,1 + beq a2,t0,.tag_anf_op_3 + mv a0,a1 + j .tag_anf_op_3_t + .tag_anf_op_3: + li a0,1 + sub t1,a2,a0 + sd t1,-24(s0) + ld a0,-24(s0) + li a2,0 + li a1,0 + call part_app + ld t1,-248(s0) + ld t0,-256(s0) + add a1,t1,t0 + sd a0,-32(s0) + sd a1,-40(s0) + ld a0,-40(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-48(s0) + ld a0,-256(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-56(s0) + lui a0,%hi(ab) + addi a0,a0,%lo(ab) + li a2,0 + li a1,2 + call part_app + sd a0,-64(s0) + lui a0,%hi(n1) + addi a0,a0,%lo(n1) + li a2,0 + li a1,1 + call part_app + sd a0,-72(s0) + lui a0,%hi(fib_acc) + addi a0,a0,%lo(fib_acc) + ld a5,-72(s0) + ld a4,-64(s0) + ld a3,-56(s0) + li a2,3 + li a1,3 + call part_app + .tag_anf_op_3_t: + sd a0,-80(s0) + mv a0,a0 + ld ra,256(sp) + ld s0,248(sp) + addi sp,sp,272 + ret + fib: + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a0,-128(s0) + li t0,2 + blt t0,a0,.tag_anf_op_13 + j .tag_anf_op_13_t + .tag_anf_op_13: + li t1,1 + sub t2,a0,t1 + li t3,2 + sub t4,a0,t3 + sd t2,-24(s0) + sd t4,-32(s0) + lui a0,%hi(fib) + addi a0,a0,%lo(fib) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + ld t4,-24(s0) + add t3,t4,a0 + sd a0,-40(s0) + sd t3,-48(s0) + lui a0,%hi(fib) + addi a0,a0,%lo(fib) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + .tag_anf_op_13_t: + sd a0,-56(s0) + mv a0,a0 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 + ret + main: + addi sp,sp,-208 + sd ra,200(sp) + sd s0,192(sp) + addi s0,sp,208 + lui a0,%hi(fib_acc) + addi a0,a0,%lo(fib_acc) + li a5,4 + li a4,1 + li a3,0 + li a2,3 + li a1,3 + call part_app + sd a0,-24(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-24(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(fib) + addi a0,a0,%lo(fib) + li a3,4 + li a2,1 + li a1,1 + call part_app + sd a0,-48(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a2,0 + li a1,0 + call part_app + li t0,0 + mv a0,t0 + ld ra,200(sp) + ld s0,192(sp) + addi sp,sp,208 + ret $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml .attribute unaligned_access, 0 @@ -656,7 +849,7 @@ ld s0,456(sp) addi sp,sp,480 ret - temp0: + rez: addi sp,sp,-112 sd ra,96(sp) sd s0,88(sp) @@ -694,29 +887,6 @@ ld s0,88(sp) addi sp,sp,112 ret - temp1: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) - lui a0,%hi(temp0) - addi a0,a0,%lo(temp0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-24(s0) - li a2,1 - li a1,1 - call part_app - mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret temp2: addi sp,sp,-80 sd ra,72(sp) @@ -781,8 +951,8 @@ li a1,0 call part_app sd a0,-40(s0) - lui a0,%hi(temp0) - addi a0,a0,%lo(temp0) + lui a0,%hi(rez) + addi a0,a0,%lo(rez) li a2,0 li a1,0 call part_app From 4ffdd7db48ab7659e93b9a496429adbce1852c9e Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Fri, 21 Mar 2025 08:12:40 +0300 Subject: [PATCH 22/24] Replace test dir --- slarnML/test/clos_conv_test.t | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index 33f32d132..46857d584 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -65,6 +65,5 @@ : end_of_input $ dune exec clos_conv_test < manytests/typed/015tuples.ml : end_of_input - $ dune exec clos_conv_test < test/manytests/typed/016lists.ml - test/manytests/typed/016lists.ml: No such file or directory - [1] + $ dune exec clos_conv_test < manytests/typed/016lists.ml + : end_of_input From 8e564769ab7b65055ec2179c9c89592344aba141 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Fri, 21 Mar 2025 08:27:00 +0300 Subject: [PATCH 23/24] Add coverage --- slarnML/lib/dune | 1 + slarnML/test/dune | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/slarnML/lib/dune b/slarnML/lib/dune index 88eaf67ff..c0c4a130a 100644 --- a/slarnML/lib/dune +++ b/slarnML/lib/dune @@ -1,6 +1,7 @@ (library (name slarnML_lib) (public_name slarnML.lib) + (instrumentation (backend bisect_ppx)) (modules Res Pprint_ast diff --git a/slarnML/test/dune b/slarnML/test/dune index d39d90c83..a32c6f7e6 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -2,30 +2,35 @@ (name parser_test) (public_name parser_test) (modules parser_test) + (preprocess (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name clos_conv_test) (public_name clos_conv_test) (modules clos_conv_test) + (preprocess (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name lambda_lifting_test) (public_name lambda_lifting_test) (modules lambda_lifting_test) + (preprocess (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name anf_conv_test) (public_name anf_conv_test) (modules anf_conv_test) + (preprocess (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name riscv64_instr_test) (public_name riscv64_instr_test) (modules riscv64_instr_test) + (preprocess (pps bisect_ppx)) (libraries slarnML.lib stdio)) (cram From dff250bb5afa95443283301f7e51b6e47d516641 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Fri, 21 Mar 2025 08:33:35 +0300 Subject: [PATCH 24/24] Format dune files --- slarnML/lib/dune | 3 ++- slarnML/test/dune | 15 ++++++++++----- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/slarnML/lib/dune b/slarnML/lib/dune index c0c4a130a..9a368a203 100644 --- a/slarnML/lib/dune +++ b/slarnML/lib/dune @@ -1,7 +1,8 @@ (library (name slarnML_lib) (public_name slarnML.lib) - (instrumentation (backend bisect_ppx)) + (instrumentation + (backend bisect_ppx)) (modules Res Pprint_ast diff --git a/slarnML/test/dune b/slarnML/test/dune index a32c6f7e6..49cf44220 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -2,35 +2,40 @@ (name parser_test) (public_name parser_test) (modules parser_test) - (preprocess (pps bisect_ppx)) + (preprocess + (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name clos_conv_test) (public_name clos_conv_test) (modules clos_conv_test) - (preprocess (pps bisect_ppx)) + (preprocess + (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name lambda_lifting_test) (public_name lambda_lifting_test) (modules lambda_lifting_test) - (preprocess (pps bisect_ppx)) + (preprocess + (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name anf_conv_test) (public_name anf_conv_test) (modules anf_conv_test) - (preprocess (pps bisect_ppx)) + (preprocess + (pps bisect_ppx)) (libraries slarnML.lib stdio)) (executable (name riscv64_instr_test) (public_name riscv64_instr_test) (modules riscv64_instr_test) - (preprocess (pps bisect_ppx)) + (preprocess + (pps bisect_ppx)) (libraries slarnML.lib stdio)) (cram