From b10fca5e2789cea10f5f8296ec68bcae7bbd2190 Mon Sep 17 00:00:00 2001 From: Ivan Shurekov Date: Sun, 16 Mar 2025 14:17:34 +0300 Subject: [PATCH 01/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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/45] 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 From 66fa675ed6a7f57fc555f3943c2ff7be9bac35c8 Mon Sep 17 00:00:00 2001 From: Ivan Date: Sun, 30 Mar 2025 14:32:13 +0300 Subject: [PATCH 25/45] Return unit tests --- slarnML/.gitignore | 1 + slarnML/lib/anf/lambda_lifting.ml | 2 +- slarnML/lib/dune | 2 +- slarnML/lib/test/anf_test.ml | 175 +++++---- slarnML/test/anf_conv_test.t | 268 ++++--------- slarnML/test/dune | 40 +- slarnML/test/lambda_lifting_test.t | 16 +- slarnML/test/riscv64_instr_test.t | 586 ++++++++++++++++------------- 8 files changed, 501 insertions(+), 589 deletions(-) diff --git a/slarnML/.gitignore b/slarnML/.gitignore index 732fd0fcc..71ac47370 100644 --- a/slarnML/.gitignore +++ b/slarnML/.gitignore @@ -1,5 +1,6 @@ .vscode _build +_coverage trash *.o diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 479aed538..c37a9c48d 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -123,7 +123,7 @@ let rec lifting cc_ast stack lvl res = (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))) + Result (if id = "()" then LIn (id, a1, a2) else a2)) |> filter lvl | CFun (args, e) -> res diff --git a/slarnML/lib/dune b/slarnML/lib/dune index 9a368a203..b1d2964e8 100644 --- a/slarnML/lib/dune +++ b/slarnML/lib/dune @@ -20,7 +20,7 @@ Lambda_lifting Anf_ast Anf_conv - ; Anf_test + Anf_test Riscv_ast Call_define Riscv diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml index 776ea10ef..e5aca1b4d 100644 --- a/slarnML/lib/test/anf_test.ml +++ b/slarnML/lib/test/anf_test.ml @@ -245,16 +245,16 @@ let ll_ok n res expected = ;; let ll1 = - [ LFun ("anon$1#fack#fac", [ "k"; "n"; "m" ], LMul (LId "k", LMul (LId "m", LId "n"))) + [ LFun ("anon$1", [ "k"; "n"; "m" ], LMul (LId "k", LMul (LId "m", LId "n"))) ; LFun - ( "fack#fac" + ( "fack" , [ "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", []) ])) + , LApp ("anon$1", [ LApp("k",[]); LApp("n",[]) ]) ) ) + ; LFun ("anon$2", [ "x" ], LId "x") + ; LFun ("fac", [ "n" ], LApp ("fack", [ LApp("n",[]); LApp ("anon$2", []) ])) ] ;; @@ -262,14 +262,14 @@ ll_ok "ll_1" (lambda_lifting cc1) ll1 let ll2 = [ LFun - ( "h#g#f" + ( "h" , [ "a"; "c"; "d"; "e" ] - , LMul (LId "a", LAdd (LId "c", LMul (LId "d", LId "e"))) ) + , LMul (LApp("a",[]), LAdd (LApp("c",[]), LMul (LApp("d",[]), LApp("e",[])))) ) ; LFun - ( "g#f" + ( "g" , [ "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) ])) + , LApp ("h", [ LApp("a",[]); LApp("c",[]); LApp("d",[]); LConst (CInt 4) ]) ) + ; LFun ("f", [ "a" ], LApp ("g", [ LApp("a",[]); LConst (CInt 2); LConst (CInt 3) ])) ] ;; @@ -277,48 +277,48 @@ ll_ok "ll_2" (lambda_lifting cc2) ll2 let ll3 = [ LFun - ( "anon$1#h#g#f" + ( "anon$1" , [ "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) ])) + , LMul (LId "x", LApp ("a", [ LMul (LId "c", LId "b") ]))) + ; LFun ("h", [ "c"; "b"; "a" ], LApp ("anon$1", [ LApp("c",[]); LApp("b",[]); LApp("a",[]) ])) + ; LFun ("g", [ "b"; "a"; "c" ], LApp ("h", [ LApp("c",[]); LApp("b",[]); LApp("a",[]); LApp("a",[]) ])) + ; LFun ("f", [ "a"; "b" ], LApp ("g", [ LApp("b",[]); LApp("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 ("h", [ "a"; "b"; "c" ], LMul (LApp("a",[]), LDiv (LApp("b",[]), LApp("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" ])) + ("g", [ "a"; "b" ], LApp ("h", [ LApp("a",[]); LConst (CInt 2); LConst (CInt 3) ])) + ; LFun ("f", [ "a" ], LApp ("g", [ LAdd (LConst (CInt 1), LConst (CInt 0)); LApp("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 ("g", [ "a"; "b" ], LDiv (LApp("a",[]), LApp("b",[]))) + ; LFun ("h", [ "a"; "c" ], LMul (LId "a", LApp("c",[]))) ; LFun ( "f" , [ "a" ] , LAdd - ( LApp ("h#f", [ LId "a"; LConst (CInt 1) ]) - , LApp ("g#f", [ LId "a"; LConst (CInt 2) ]) ) ) + ( LApp ("h", [ LApp("a",[]); LConst (CInt 1) ]) + , LApp ("g", [ LApp("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 ("anon$1", [ "x" ], LId "x") + ; LFun ("g", [], LApp ("anon$1", [])) + ; LFun ("anon$2", [ "a"; "x" ], LMul (LId "a", LId "x")) + ; LFun ("h", [ "a" ], LApp ("anon$2", [ LApp("a",[]) ])) ; LFun - ("f", [ "a" ], LAdd (LApp ("g#f", [ LId "a" ]), LApp ("h#f", [ LId "a"; LId "a" ]))) + ("f", [ "a" ], LAdd (LApp ("g", [ LApp("a",[]) ]), LApp ("h", [ LApp("a",[]); LApp("a",[]) ]))) ] ;; @@ -351,17 +351,16 @@ let anf_ok n ll expected = let anf1 = [ AFun - ( "anon$1#fack#fac" + ( "anon$1" , [ "k"; "n"; "m" ] , ALet ( "anf_op#1" , AMul (AId "m", AId "n") , ALet - ( "anf_op#2" - , AMul (AId "k", AId "anf_op#1") + ( "anf_op#2", AMul (AId "k", AId "anf_op#1") , ACExpr (CImmExpr (AId "anf_op#2")) ) ) ) ; AFun - ( "fack#fac" + ( "fack" , [ "n"; "k" ] , ALet ( "anf_op#3" @@ -374,25 +373,23 @@ let anf1 = ( "anf_op#5" , ASub (AId "n", AInt 1) , ALet - ( "anf_app#6" - , AApp (AId "n", [ AId "anf_op#5" ]) + ( "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")) ) ) + , ALet ( "anf_app#7", AApp (AId "k", []) + , ALet ("anf_app#8", AApp (AId "n", []) + , ALet ("anf_app#9", AApp (AId "anon$1", [ AId "anf_app#7"; AId "anf_app#8" ]) + , ACExpr (CImmExpr (AId "anf_app#9")))))) , ACExpr (CImmExpr (AId "anf_if#4")) ) ) ) - ; AFun ("anon$2#fac", [ "x" ], ACExpr (CImmExpr (AId "x"))) + ; AFun ("anon$2", [ "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun ( "fac" , [ "n" ] , ALet - ( "anf_app#8" - , AApp (AId "anon$2#fac", []) + ( "anf_app#10", AApp (AId "n", []) + , ALet ( "anf_app#11", AApp (AId "anon$2", []) , ALet - ( "anf_app#9" - , AApp (AId "fack#fac", [ AId "n"; AId "anf_app#8" ]) - , ACExpr (CImmExpr (AId "anf_app#9")) ) ) ) + ( "anf_app#12", AApp (AId "fack", [ AId "anf_app#10"; AId "anf_app#11" ]) + , ACExpr (CImmExpr (AId "anf_app#12")) ) ) )) ] ;; @@ -400,32 +397,35 @@ let%test _ = anf_ok "anf_1" ll1 anf1 let anf4 = [ AFun - ( "h#g#f" + ( "h" , [ "a"; "b"; "c" ] , ALet - ( "anf_op#1" - , ADiv (AId "b", AId "c") + ( "anf_app#1", AApp (AId "a", []) + , ALet ("anf_app#2", AApp (AId "b", []) + , ALet ("anf_app#3", AApp (AId "c", []) + , ALet ("anf_op#4", ADiv (AId "anf_app#2", AId "anf_app#3") , ALet - ( "anf_op#2" - , AMul (AId "a", AId "anf_op#1") - , ACExpr (CImmExpr (AId "anf_op#2")) ) ) ) + ( "anf_op#5" + , AMul (AId "anf_app#1", AId "anf_op#4") + , ACExpr (CImmExpr (AId "anf_op#5")) ) ) )))) ; AFun - ( "g#f" + ( "g" , [ "a"; "b" ] , ALet - ( "anf_app#3" - , AApp (AId "h#g#f", [ AId "a"; AInt 2; AInt 3 ]) - , ACExpr (CImmExpr (AId "anf_app#3")) ) ) + ( "anf_app#6", AApp (AId "a", []) + , ALet ("anf_app#7", AApp (AId "h", [ AId "anf_app#6"; AInt 2; AInt 3 ]) + , ACExpr (CImmExpr (AId "anf_app#7")) ) )) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_op#4" + ( "anf_op#8" , 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")) ) ) ) + ( "anf_app#9" + , AApp (AId "a", []) + , ALet ("anf_app#10", AApp (AId "g", [ AId "anf_op#8"; AId "anf_app#9" ]) + , ACExpr (CImmExpr (AId "anf_app#10")) ) ) )) ] ;; @@ -433,63 +433,58 @@ let%test _ = anf_ok "anf_4" ll4 anf4 let anf5 = [ AFun - ( "g#f" + ( "g" , [ "a"; "b" ] - , ALet ("anf_op#1", ADiv (AId "a", AId "b"), ACExpr (CImmExpr (AId "anf_op#1"))) ) + , ALet ("anf_app#1", AApp(AId "a", []) + , ALet ("anf_app#2", AApp(AId "b", []) + , ALet ("anf_op#3", ADiv (AId "anf_app#1", AId "anf_app#2"), ACExpr (CImmExpr (AId "anf_op#3"))) ))) ; AFun - ( "h#f" + ( "h" , [ "a"; "c" ] - , ALet ("anf_op#2", AMul (AId "a", AId "c"), ACExpr (CImmExpr (AId "anf_op#2"))) ) + , ALet ("anf_app#4", AApp(AId "c", []) + , ALet ("anf_op#5", AMul (AId "a", AId "anf_app#4"), ACExpr (CImmExpr (AId "anf_op#5"))) )) ; 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")) ) ) ) ) + , ALet ("anf_app#6", AApp(AId "a", []) + , ALet( "anf_app#7", AApp (AId "h", [ AId "anf_app#6"; AInt 1 ]) + , ALet ("anf_app#8", AApp(AId "a", []) + , ALet( "anf_app#9", AApp (AId "g", [ AId "anf_app#8"; AInt 2 ]) + , ALet( "anf_op#10", AAdd (AId "anf_app#7", AId "anf_app#9") + , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ))) ] ;; let%test _ = anf_ok "anf_5" ll5 anf5 let anf6 = - [ AFun ("anon$1#g#f", [ "x" ], ACExpr (CImmExpr (AId "x"))) + [ AFun ("anon$1", [ "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun - ( "g#f" + ( "g" , [] , ALet - ("anf_app#1", AApp (AId "anon$1#g#f", []), ACExpr (CImmExpr (AId "anf_app#1"))) + ("anf_app#1", AApp (AId "anon$1", []), ACExpr (CImmExpr (AId "anf_app#1"))) ) ; AFun - ( "anon$2#h#f" + ( "anon$2" , [ "a"; "x" ] , ALet ("anf_op#2", AMul (AId "a", AId "x"), ACExpr (CImmExpr (AId "anf_op#2"))) ) ; AFun - ( "h#f" + ( "h" , [ "a" ] - , ALet - ( "anf_app#3" - , AApp (AId "anon$2#h#f", [ AId "a" ]) - , ACExpr (CImmExpr (AId "anf_app#3")) ) ) + , ALet( "anf_app#3", AApp (AId "a", []) + , ALet( "anf_app#4", AApp (AId "anon$2", [ AId "anf_app#3" ]) + , ACExpr (CImmExpr (AId "anf_app#4")) ) )) ; 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")) ) ) ) ) + , ALet( "anf_app#5", AApp (AId "a", []) + , ALet( "anf_app#6", AApp (AId "g", [ AId "anf_app#5" ]) + , ALet( "anf_app#7", AApp (AId "a", []) + , ALet( "anf_app#8", AApp (AId "a", []) + , ALet( "anf_app#9", AApp (AId "h", [ AId "anf_app#7"; AId "anf_app#8" ]) + , ALet( "anf_op#10", AAdd (AId "anf_app#6", AId "anf_app#9") + , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) )))) ] ;; diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 9b20f5e67..6abdf0e23 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -40,35 +40,13 @@ 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 ) + (let anf_app#12=(n ) in - (let anf_app#22=(anon$2 ) + (let anf_app#13=(anon$2 ) in - (let anf_app#23=(fack anf_app#21 anf_app#22) + (let anf_app#14=(fack anf_app#12 anf_app#13) in - anf_app#23)))))) + anf_app#14))) ) $ dune exec anf_conv_test << EOF > let fac n = @@ -94,27 +72,11 @@ 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)))) + (let anf_app#6=(n ) in - (let anf_fack#11=(anf_if#7 ) + (let anf_app#7=(fack anf_app#6) in - (let anf_app#12=(n ) - in - (let anf_app#13=(fack anf_app#12) - in - anf_app#13))))) + anf_app#7)) ) $ dune exec anf_conv_test << EOF > let f a = @@ -148,58 +110,16 @@ 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 ) + (let anf_app#11=(h anf_app#8 anf_app#9 anf_app#10 4) in - (let anf_app#19=(h anf_app#16 anf_app#17 anf_app#18 4) - in - anf_app#19)))))))))))) + anf_app#11)))) ) (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 ) + (let anf_app#12=(a ) in - (let anf_app#30=(d ) + (let anf_app#13=(g anf_app#12 2 3) 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))))))))))))))) + anf_app#13)) ) $ dune exec anf_conv_test < manytests/do_not_type/001.ml fac not exist @@ -305,59 +225,51 @@ then ( b ) else ( - (let anf_op#5=(n-1) - in - (let anf_n1#6=(anf_op#5 ) + (let anf_app#5=(b ) in - (let anf_op#7=(a+b) + (let anf_app#6=(ab ) in - (let anf_ab#8=(anf_op#7 ) + (let anf_app#7=(n1 ) in - (let anf_app#9=(b ) + (let anf_app#8=(fib_acc anf_app#5 anf_app#6 anf_app#7) 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))))))))) + anf_app#8))))) in anf_if#4)) ) (fun fib(n)-> - (let anf_op#13=(n<2) + (let anf_op#9=(n<2) in - (let anf_if#14=if (anf_op#13) + (let anf_if#10=if (anf_op#9) then ( n ) else ( - (let anf_op#15=(n-1) + (let anf_op#11=(n-1) in - (let anf_op#16=(n-2) + (let anf_op#12=(n-2) in - (let anf_app#17=(fib anf_op#16) + (let anf_app#13=(fib anf_op#12) in - (let anf_op#18=(anf_op#15+anf_app#17) + (let anf_op#14=(anf_op#11+anf_app#13) in - (let anf_app#19=(fib anf_op#18) + (let anf_app#15=(fib anf_op#14) in - anf_app#19)))))) + anf_app#15)))))) in - anf_if#14)) + anf_if#10)) ) (fun main()-> - (let anf_app#20=(fib_acc 0 1 4) + (let anf_app#16=(fib_acc 0 1 4) in - (let anf_app#21=(print_int anf_app#20) + (let anf_app#17=(print_int anf_app#16) in - (let anf_()#22=(anf_app#21 ) + (let anf_()#18=(anf_app#17 ) in - (let anf_app#23=(fib 4) + (let anf_app#19=(fib 4) in - (let anf_app#24=(print_int anf_app#23) + (let anf_app#20=(print_int anf_app#19) in - (let anf_()#25=(anf_app#24 ) + (let anf_()#21=(anf_app#20 ) in 0)))))) ) @@ -399,101 +311,71 @@ 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))))))))) + 0 ) (fun test10(a b c d e f g h i j)-> - (let anf_app#20=(a ) + (let anf_app#11=(a ) in - (let anf_app#21=(b ) + (let anf_app#12=(b ) in - (let anf_op#22=(anf_app#20+anf_app#21) + (let anf_op#13=(anf_app#11+anf_app#12) in - (let anf_app#23=(c ) + (let anf_app#14=(c ) in - (let anf_op#24=(anf_op#22+anf_app#23) + (let anf_op#15=(anf_op#13+anf_app#14) in - (let anf_app#25=(d ) + (let anf_app#16=(d ) in - (let anf_op#26=(anf_op#24+anf_app#25) + (let anf_op#17=(anf_op#15+anf_app#16) in - (let anf_app#27=(e ) + (let anf_app#18=(e ) in - (let anf_op#28=(anf_op#26+anf_app#27) + (let anf_op#19=(anf_op#17+anf_app#18) in - (let anf_app#29=(f ) + (let anf_app#20=(f ) in - (let anf_op#30=(anf_op#28+anf_app#29) + (let anf_op#21=(anf_op#19+anf_app#20) in - (let anf_app#31=(g ) + (let anf_app#22=(g ) in - (let anf_op#32=(anf_op#30+anf_app#31) + (let anf_op#23=(anf_op#21+anf_app#22) in - (let anf_app#33=(h ) + (let anf_app#24=(h ) in - (let anf_op#34=(anf_op#32+anf_app#33) + (let anf_op#25=(anf_op#23+anf_app#24) in - (let anf_app#35=(i ) + (let anf_app#26=(i ) in - (let anf_op#36=(anf_op#34+anf_app#35) + (let anf_op#27=(anf_op#25+anf_app#26) in - (let anf_app#37=(j ) + (let anf_app#28=(j ) in - (let anf_op#38=(anf_op#36+anf_app#37) + (let anf_op#29=(anf_op#27+anf_app#28) in - anf_op#38))))))))))))))))))) + anf_op#29))))))))))))))))))) ) (fun rez()-> - (let anf_app#39=(test10 ) + (let anf_app#30=(test10 ) in - (let anf_app#40=(wrap anf_app#39 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#31=(wrap anf_app#30 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - anf_app#40)) + anf_app#31)) ) (fun temp2()-> - (let anf_app#41=(test3 ) + (let anf_app#32=(test3 ) in - (let anf_app#42=(wrap anf_app#41 1 10 100) + (let anf_app#33=(wrap anf_app#32 1 10 100) in - anf_app#42)) + anf_app#33)) ) (fun main()-> - (let anf_app#43=(test10 ) - in - (let anf_app#44=(wrap anf_app#43 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) - in - (let anf_rez#45=(anf_app#44 ) - in - (let anf_app#46=(rez ) + (let anf_app#34=(rez ) in - (let anf_app#47=(print_int anf_app#46) + (let anf_app#35=(print_int anf_app#34) in - (let anf_()#48=(anf_app#47 ) + (let anf_()#36=(anf_app#35 ) in - (let anf_app#49=(test3 ) - in - (let anf_app#50=(wrap anf_app#49 1 10 100) - in - (let anf_temp2#51=(anf_app#50 ) - in - 0))))))))) + 0))) ) $ dune exec anf_conv_test < manytests/typed/005fix.ml (fun fix(f x)-> @@ -641,29 +523,13 @@ anf_app#19)) ) (fun main()-> - (let anf_app#20=(foo 1) - in - (let anf_foo#21=(anf_app#20 ) + (let anf_app#20=(foo ) 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) + (let anf_app#21=(print_int anf_app#20) in - (let anf_()#30=(anf_app#29 ) + (let anf_()#22=(anf_app#21 ) in - 0))))))))))) + 0))) ) $ dune exec anf_conv_test < manytests/typed/006partial3.ml (fun anon$2(c)-> diff --git a/slarnML/test/dune b/slarnML/test/dune index 49cf44220..98235cf6a 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -133,23 +133,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/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index ed04be25b..b37060538 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -7,7 +7,7 @@ (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 ))))) + (fun fac(n)->((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 @@ -15,7 +15,7 @@ > ;; > 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 ))))) + (fun fac(n)->((fack (n )))) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -25,8 +25,8 @@ > (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)))) + (fun g(a c d)->((h (a ) (c ) (d ) 4))) + (fun f(a)->((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 @@ -44,7 +44,7 @@ $ dune exec lambda_lifting_test < manytests/typed/003fib.ml (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_acc(a b n)->(if ((n=1)) then (b) else ((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 @@ -52,11 +52,11 @@ (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 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 rez()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) (fun temp2()->((wrap (test3 ) 1 10 100))) - (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))))) + (fun main()->(let () = ((print_int (rez )) 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)))))) @@ -72,7 +72,7 @@ (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)))))) + (fun main()->(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 )))) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index 20345adae..ebf71ffd0 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -4,7 +4,141 @@ > (fack n (fun x -> x)) > ;; > EOF - f not found + .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,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 + sd a2,-112(s0) + sd a1,-104(s0) + sd a0,-96(s0) + ld a0,-96(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + ld a0,-104(s0) + ld a3,-24(s0) + li a2,1 + li a1,0 + call part_app + ld a1,-112(s0) + mul a2,a1,a0 + mv a0,a2 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 + ret + fack: + 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 + ble t0,a0,.tag_anf_op_4 + ld a0,-216(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + j .tag_anf_op_4_t + .tag_anf_op_4: + 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(fack) + addi a0,a0,%lo(fack) + ld a4,-56(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + .tag_anf_op_4_t: + sd a0,-64(s0) + mv a0,a0 + ld ra,208(sp) + ld s0,200(sp) + addi sp,sp,224 + ret + anon_2: + 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,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 + sd a0,-120(s0) + ld a0,-120(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + li a2,0 + li a1,1 + call part_app + sd a0,-32(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a4,-32(s0) + ld a3,-24(s0) + li a2,2 + li a1,2 + call part_app + mv a0,a0 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 + 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 @@ -58,51 +192,26 @@ 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) + 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,-64(s0) + sd a0,-24(s0) lui a0,%hi(fack) addi a0,a0,%lo(fack) - ld a3,-64(s0) + ld a3,-24(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 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 ret $ dune exec riscv64_instr_test << EOF > let f a = @@ -112,7 +221,123 @@ > in > (g 2 3) > EOF - e not found + .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: + addi sp,sp,-208 + sd ra,192(sp) + sd s0,184(sp) + addi s0,sp,208 + sd a3,-200(s0) + sd a2,-192(s0) + sd a1,-184(s0) + sd a0,-176(s0) + ld a0,-176(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-24(s0) + ld a0,-184(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 + sd a0,-40(s0) + ld a0,-200(s0) + li a2,0 + li a1,0 + call part_app + ld a1,-40(s0) + mul a2,a1,a0 + ld a3,-32(s0) + add t0,a3,a2 + ld t1,-24(s0) + mul t2,t1,t0 + mv a0,t2 + ld ra,192(sp) + ld s0,184(sp) + addi sp,sp,208 + ret + g: + addi sp,sp,-176 + sd ra,160(sp) + sd s0,152(sp) + addi s0,sp,176 + sd a2,-168(s0) + 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) + ld a0,-160(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-32(s0) + ld a0,-168(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-40(s0) + lui a0,%hi(h) + addi a0,a0,%lo(h) + li a6,4 + ld a5,-40(s0) + ld a4,-32(s0) + ld a3,-24(s0) + li a2,4 + li a1,4 + call part_app + mv a0,a0 + ld ra,160(sp) + ld s0,152(sp) + addi sp,sp,176 + ret + f: + 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(g) + addi a0,a0,%lo(g) + li a5,3 + li a4,2 + ld a3,-24(s0) + li a2,3 + li a1,3 + call part_app + mv a0,a0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml fac not exist @@ -421,66 +646,49 @@ 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) + addi sp,sp,-192 + sd ra,176(sp) + sd s0,168(sp) + addi s0,sp,192 + sd a2,-184(s0) + sd a1,-176(s0) + sd a0,-168(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) + ld a0,-176(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) + sd a0,-24(s0) lui a0,%hi(ab) addi a0,a0,%lo(ab) li a2,0 li a1,2 call part_app - sd a0,-64(s0) + sd a0,-32(s0) lui a0,%hi(n1) addi a0,a0,%lo(n1) li a2,0 li a1,1 call part_app - sd a0,-72(s0) + sd a0,-40(s0) lui a0,%hi(fib_acc) addi a0,a0,%lo(fib_acc) - ld a5,-72(s0) - ld a4,-64(s0) - ld a3,-56(s0) + ld a5,-40(s0) + ld a4,-32(s0) + ld a3,-24(s0) li a2,3 li a1,3 call part_app .tag_anf_op_3_t: - sd a0,-80(s0) + sd a0,-48(s0) mv a0,a0 - ld ra,256(sp) - ld s0,248(sp) - addi sp,sp,272 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 ret fib: addi sp,sp,-128 @@ -489,9 +697,9 @@ 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: + blt t0,a0,.tag_anf_op_9 + j .tag_anf_op_9_t + .tag_anf_op_9: li t1,1 sub t2,a0,t1 li t3,2 @@ -514,7 +722,7 @@ li a2,1 li a1,1 call part_app - .tag_anf_op_13_t: + .tag_anf_op_9_t: sd a0,-56(s0) mv a0,a0 ld ra,120(sp) @@ -687,71 +895,18 @@ 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 + addi sp,sp,-48 + sd ra,32(sp) + sd s0,24(sp) + addi s0,sp,48 + sd a2,-40(s0) + sd a1,-32(s0) 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 + li t0,0 + mv a0,t0 + ld ra,32(sp) + ld s0,24(sp) + addi sp,sp,48 ret test10: addi sp,sp,-480 @@ -913,87 +1068,32 @@ 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) + addi sp,sp,-112 + sd ra,104(sp) + sd s0,96(sp) + addi s0,sp,112 lui a0,%hi(rez) addi a0,a0,%lo(rez) li a2,0 li a1,0 call part_app - sd a0,-48(s0) + sd a0,-24(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-48(s0) + ld a3,-24(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) + 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,320(sp) - ld s0,312(sp) - addi sp,sp,336 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 ret $ dune exec riscv64_instr_test < manytests/typed/005fix.ml @@ -1450,82 +1550,32 @@ 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) + 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 a2,0 li a1,3 call part_app - sd a0,-88(s0) + sd a0,-24(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-88(s0) + ld a3,-24(s0) li a2,1 li a1,1 call part_app - sd a0,-96(s0) - ld a0,-96(s0) + 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,360(sp) - ld s0,352(sp) - addi sp,sp,368 + ld ra,104(sp) + ld s0,96(sp) + addi sp,sp,112 ret $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml From dd48adc9b00f917e41f99e9708c2fcbf01cd7afe Mon Sep 17 00:00:00 2001 From: Ivan Date: Sun, 30 Mar 2025 17:00:07 +0300 Subject: [PATCH 26/45] Add anon cnt --- slarnML/lib/anf/lambda_lifting.ml | 21 +-- slarnML/lib/riscv64/part_app.c | 6 +- slarnML/lib/riscv64/riscv.ml | 96 +++++++------- slarnML/lib/test/anf_test.ml | 205 ++++++++++++++++++++--------- slarnML/test/anf_conv_test.t | 4 +- slarnML/test/exec_test.t_ | Bin 4185 -> 7394 bytes slarnML/test/lambda_lifting_test.t | 4 +- slarnML/test/riscv64_instr_test.t | 80 +++++------ 8 files changed, 252 insertions(+), 164 deletions(-) diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index c37a9c48d..fb6429e36 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -34,6 +34,7 @@ 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 get_num = map (fun (_, _, _, num) -> Result num) let update_ast f = map (fun (ast, prog, env, num) -> @@ -122,8 +123,7 @@ let rec lifting cc_ast stack lvl res = >>= 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 (if id = "()" then LIn (id, a1, a2) else a2)) + |> update_ast (fun a2 -> Result (if id = "()" then LIn (id, a1, a2) else a2)) |> filter lvl | CFun (args, e) -> res @@ -169,14 +169,19 @@ let rec lifting cc_ast stack lvl res = | _ -> Error "Apply on not correct expr") ;; -let default_res = Result (LId "Error", [], [], 0) +let default_res num = Result (LId "Error", [], [], num) 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 []) + (fun prev_res ast -> + prev_res + >>= fun (anon_num, ll_ast) -> + lifting ast [] 0 (default_res anon_num) + |> fun res -> + res + |> get_num + >>= fun num -> res |> get_prog >>= fun p -> Result (num, ll_ast @ List.rev p)) + (Result (0, [])) cc_ast + >>= fun (_, ast) -> Result ast ;; diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index 1be02822f..bbddfe5da 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -29,6 +29,10 @@ struct Func func_init(void *ptr, uint8_t cnt) { new.ptr = ptr; new.argscnt = cnt; new.argsfun = malloc(sizeof(int64_t)*min((int64_t)MAX_ARGS, cnt)); + if (!new.argsfun) { + fprintf(stderr, "Memory allocation failed!"); + exit(1); + } new.cnt = 0; return new; } @@ -92,7 +96,7 @@ int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { 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]) { + if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS-1]) { part_apps[last_app] = *(struct Func *)f_ptr; } else { part_apps[last_app] = func_init(f_ptr, argcnt); diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index eb1270d81..d68d38aa8 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 @@ -574,7 +574,7 @@ let init_fun anf res = 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 + let offset_align = 16 * ((offset_full + 15) / 16) in res |> add_fun id (List.length args) |> save_args (-offset_full) args @@ -608,17 +608,17 @@ let head = ; Attribute "stack_align, 16" ; Global "_start" ; Tag "_start" - ; Mathi (Add, Sp, Sp, ImmInt (-24)) + ; Mathi (Add, Sp, Sp, ImmInt (-32)) ; Sd (Ra, ImmInt 16, Sp) ; Sd (S 0, ImmInt 8, Sp) ; Sd (S 1, ImmInt 0, Sp) - ; Mathi (Add, S 0, Sp, ImmInt 24) + ; Mathi (Add, S 0, Sp, ImmInt 32) ; 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) + ; Mathi (Add, Sp, Sp, ImmInt 32) ; Li (A 7, ImmInt exit) ; Ecall ] diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml index e5aca1b4d..673d81976 100644 --- a/slarnML/lib/test/anf_test.ml +++ b/slarnML/lib/test/anf_test.ml @@ -252,9 +252,9 @@ let ll1 = , LIf ( LLte (LId "n", LConst (CInt 1)) , LApp ("n", [ LSub (LId "n", LConst (CInt 1)) ]) - , LApp ("anon$1", [ LApp("k",[]); LApp("n",[]) ]) ) ) + , LApp ("anon$1", [ LApp ("k", []); LApp ("n", []) ]) ) ) ; LFun ("anon$2", [ "x" ], LId "x") - ; LFun ("fac", [ "n" ], LApp ("fack", [ LApp("n",[]); LApp ("anon$2", []) ])) + ; LFun ("fac", [ "n" ], LApp ("fack", [ LApp ("n", []); LApp ("anon$2", []) ])) ] ;; @@ -264,12 +264,13 @@ let ll2 = [ LFun ( "h" , [ "a"; "c"; "d"; "e" ] - , LMul (LApp("a",[]), LAdd (LApp("c",[]), LMul (LApp("d",[]), LApp("e",[])))) ) + , LMul (LApp ("a", []), LAdd (LApp ("c", []), LMul (LApp ("d", []), LApp ("e", [])))) + ) ; LFun ( "g" , [ "a"; "c"; "d" ] - , LApp ("h", [ LApp("a",[]); LApp("c",[]); LApp("d",[]); LConst (CInt 4) ]) ) - ; LFun ("f", [ "a" ], LApp ("g", [ LApp("a",[]); LConst (CInt 2); LConst (CInt 3) ])) + , LApp ("h", [ LApp ("a", []); LApp ("c", []); LApp ("d", []); LConst (CInt 4) ]) ) + ; LFun ("f", [ "a" ], LApp ("g", [ LApp ("a", []); LConst (CInt 2); LConst (CInt 3) ])) ] ;; @@ -279,34 +280,47 @@ let ll3 = [ LFun ( "anon$1" , [ "c"; "b"; "a"; "x" ] - , LMul (LId "x", LApp ("a", [ LMul (LId "c", LId "b") ]))) - ; LFun ("h", [ "c"; "b"; "a" ], LApp ("anon$1", [ LApp("c",[]); LApp("b",[]); LApp("a",[]) ])) - ; LFun ("g", [ "b"; "a"; "c" ], LApp ("h", [ LApp("c",[]); LApp("b",[]); LApp("a",[]); LApp("a",[]) ])) - ; LFun ("f", [ "a"; "b" ], LApp ("g", [ LApp("b",[]); LApp("a",[]); LConst (CInt 3) ])) + , LMul (LId "x", LApp ("a", [ LMul (LId "c", LId "b") ])) ) + ; LFun + ( "h" + , [ "c"; "b"; "a" ] + , LApp ("anon$1", [ LApp ("c", []); LApp ("b", []); LApp ("a", []) ]) ) + ; LFun + ( "g" + , [ "b"; "a"; "c" ] + , LApp ("h", [ LApp ("c", []); LApp ("b", []); LApp ("a", []); LApp ("a", []) ]) ) + ; LFun + ("f", [ "a"; "b" ], LApp ("g", [ LApp ("b", []); LApp ("a", []); LConst (CInt 3) ])) ] ;; ll_ok "ll_3" (lambda_lifting cc3) ll3 let ll4 = - [ LFun ("h", [ "a"; "b"; "c" ], LMul (LApp("a",[]), LDiv (LApp("b",[]), LApp("c",[])))) + [ LFun + ( "h" + , [ "a"; "b"; "c" ] + , LMul (LApp ("a", []), LDiv (LApp ("b", []), LApp ("c", []))) ) + ; LFun + ("g", [ "a"; "b" ], LApp ("h", [ LApp ("a", []); LConst (CInt 2); LConst (CInt 3) ])) ; LFun - ("g", [ "a"; "b" ], LApp ("h", [ LApp("a",[]); LConst (CInt 2); LConst (CInt 3) ])) - ; LFun ("f", [ "a" ], LApp ("g", [ LAdd (LConst (CInt 1), LConst (CInt 0)); LApp("a",[]) ])) + ( "f" + , [ "a" ] + , LApp ("g", [ LAdd (LConst (CInt 1), LConst (CInt 0)); LApp ("a", []) ]) ) ] ;; ll_ok "ll_4" (lambda_lifting cc4) ll4 let ll5 = - [ LFun ("g", [ "a"; "b" ], LDiv (LApp("a",[]), LApp("b",[]))) - ; LFun ("h", [ "a"; "c" ], LMul (LId "a", LApp("c",[]))) + [ LFun ("g", [ "a"; "b" ], LDiv (LApp ("a", []), LApp ("b", []))) + ; LFun ("h", [ "a"; "c" ], LMul (LId "a", LApp ("c", []))) ; LFun ( "f" , [ "a" ] , LAdd - ( LApp ("h", [ LApp("a",[]); LConst (CInt 1) ]) - , LApp ("g", [ LApp("a",[]); LConst (CInt 2) ]) ) ) + ( LApp ("h", [ LApp ("a", []); LConst (CInt 1) ]) + , LApp ("g", [ LApp ("a", []); LConst (CInt 2) ]) ) ) ] ;; @@ -316,9 +330,13 @@ let ll6 = [ LFun ("anon$1", [ "x" ], LId "x") ; LFun ("g", [], LApp ("anon$1", [])) ; LFun ("anon$2", [ "a"; "x" ], LMul (LId "a", LId "x")) - ; LFun ("h", [ "a" ], LApp ("anon$2", [ LApp("a",[]) ])) + ; LFun ("h", [ "a" ], LApp ("anon$2", [ LApp ("a", []) ])) ; LFun - ("f", [ "a" ], LAdd (LApp ("g", [ LApp("a",[]) ]), LApp ("h", [ LApp("a",[]); LApp("a",[]) ]))) + ( "f" + , [ "a" ] + , LAdd + (LApp ("g", [ LApp ("a", []) ]), LApp ("h", [ LApp ("a", []); LApp ("a", []) ])) + ) ] ;; @@ -357,7 +375,8 @@ let anf1 = ( "anf_op#1" , AMul (AId "m", AId "n") , ALet - ( "anf_op#2", AMul (AId "k", AId "anf_op#1") + ( "anf_op#2" + , AMul (AId "k", AId "anf_op#1") , ACExpr (CImmExpr (AId "anf_op#2")) ) ) ) ; AFun ( "fack" @@ -373,23 +392,34 @@ let anf1 = ( "anf_op#5" , ASub (AId "n", AInt 1) , ALet - ( "anf_app#6", AApp (AId "n", [ AId "anf_op#5" ]) + ( "anf_app#6" + , AApp (AId "n", [ AId "anf_op#5" ]) , ACExpr (CImmExpr (AId "anf_app#6")) ) ) - , ALet ( "anf_app#7", AApp (AId "k", []) - , ALet ("anf_app#8", AApp (AId "n", []) - , ALet ("anf_app#9", AApp (AId "anon$1", [ AId "anf_app#7"; AId "anf_app#8" ]) - , ACExpr (CImmExpr (AId "anf_app#9")))))) + , ALet + ( "anf_app#7" + , AApp (AId "k", []) + , ALet + ( "anf_app#8" + , AApp (AId "n", []) + , ALet + ( "anf_app#9" + , AApp (AId "anon$1", [ AId "anf_app#7"; AId "anf_app#8" ]) + , ACExpr (CImmExpr (AId "anf_app#9")) ) ) ) ) , ACExpr (CImmExpr (AId "anf_if#4")) ) ) ) ; AFun ("anon$2", [ "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun ( "fac" , [ "n" ] , ALet - ( "anf_app#10", AApp (AId "n", []) - , ALet ( "anf_app#11", AApp (AId "anon$2", []) + ( "anf_app#10" + , AApp (AId "n", []) , ALet - ( "anf_app#12", AApp (AId "fack", [ AId "anf_app#10"; AId "anf_app#11" ]) - , ACExpr (CImmExpr (AId "anf_app#12")) ) ) )) + ( "anf_app#11" + , AApp (AId "anon$2", []) + , ALet + ( "anf_app#12" + , AApp (AId "fack", [ AId "anf_app#10"; AId "anf_app#11" ]) + , ACExpr (CImmExpr (AId "anf_app#12")) ) ) ) ) ] ;; @@ -400,21 +430,31 @@ let anf4 = ( "h" , [ "a"; "b"; "c" ] , ALet - ( "anf_app#1", AApp (AId "a", []) - , ALet ("anf_app#2", AApp (AId "b", []) - , ALet ("anf_app#3", AApp (AId "c", []) - , ALet ("anf_op#4", ADiv (AId "anf_app#2", AId "anf_app#3") + ( "anf_app#1" + , AApp (AId "a", []) , ALet - ( "anf_op#5" - , AMul (AId "anf_app#1", AId "anf_op#4") - , ACExpr (CImmExpr (AId "anf_op#5")) ) ) )))) + ( "anf_app#2" + , AApp (AId "b", []) + , ALet + ( "anf_app#3" + , AApp (AId "c", []) + , ALet + ( "anf_op#4" + , ADiv (AId "anf_app#2", AId "anf_app#3") + , ALet + ( "anf_op#5" + , AMul (AId "anf_app#1", AId "anf_op#4") + , ACExpr (CImmExpr (AId "anf_op#5")) ) ) ) ) ) ) ; AFun ( "g" , [ "a"; "b" ] , ALet - ( "anf_app#6", AApp (AId "a", []) - , ALet ("anf_app#7", AApp (AId "h", [ AId "anf_app#6"; AInt 2; AInt 3 ]) - , ACExpr (CImmExpr (AId "anf_app#7")) ) )) + ( "anf_app#6" + , AApp (AId "a", []) + , ALet + ( "anf_app#7" + , AApp (AId "h", [ AId "anf_app#6"; AInt 2; AInt 3 ]) + , ACExpr (CImmExpr (AId "anf_app#7")) ) ) ) ; AFun ( "f" , [ "a" ] @@ -424,8 +464,10 @@ let anf4 = , ALet ( "anf_app#9" , AApp (AId "a", []) - , ALet ("anf_app#10", AApp (AId "g", [ AId "anf_op#8"; AId "anf_app#9" ]) - , ACExpr (CImmExpr (AId "anf_app#10")) ) ) )) + , ALet + ( "anf_app#10" + , AApp (AId "g", [ AId "anf_op#8"; AId "anf_app#9" ]) + , ACExpr (CImmExpr (AId "anf_app#10")) ) ) ) ) ] ;; @@ -435,23 +477,45 @@ let anf5 = [ AFun ( "g" , [ "a"; "b" ] - , ALet ("anf_app#1", AApp(AId "a", []) - , ALet ("anf_app#2", AApp(AId "b", []) - , ALet ("anf_op#3", ADiv (AId "anf_app#1", AId "anf_app#2"), ACExpr (CImmExpr (AId "anf_op#3"))) ))) + , ALet + ( "anf_app#1" + , AApp (AId "a", []) + , ALet + ( "anf_app#2" + , AApp (AId "b", []) + , ALet + ( "anf_op#3" + , ADiv (AId "anf_app#1", AId "anf_app#2") + , ACExpr (CImmExpr (AId "anf_op#3")) ) ) ) ) ; AFun ( "h" , [ "a"; "c" ] - , ALet ("anf_app#4", AApp(AId "c", []) - , ALet ("anf_op#5", AMul (AId "a", AId "anf_app#4"), ACExpr (CImmExpr (AId "anf_op#5"))) )) + , ALet + ( "anf_app#4" + , AApp (AId "c", []) + , ALet + ( "anf_op#5" + , AMul (AId "a", AId "anf_app#4") + , ACExpr (CImmExpr (AId "anf_op#5")) ) ) ) ; AFun ( "f" , [ "a" ] - , ALet ("anf_app#6", AApp(AId "a", []) - , ALet( "anf_app#7", AApp (AId "h", [ AId "anf_app#6"; AInt 1 ]) - , ALet ("anf_app#8", AApp(AId "a", []) - , ALet( "anf_app#9", AApp (AId "g", [ AId "anf_app#8"; AInt 2 ]) - , ALet( "anf_op#10", AAdd (AId "anf_app#7", AId "anf_app#9") - , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ))) + , ALet + ( "anf_app#6" + , AApp (AId "a", []) + , ALet + ( "anf_app#7" + , AApp (AId "h", [ AId "anf_app#6"; AInt 1 ]) + , ALet + ( "anf_app#8" + , AApp (AId "a", []) + , ALet + ( "anf_app#9" + , AApp (AId "g", [ AId "anf_app#8"; AInt 2 ]) + , ALet + ( "anf_op#10" + , AAdd (AId "anf_app#7", AId "anf_app#9") + , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ) ) ) ] ;; @@ -462,8 +526,7 @@ let anf6 = ; AFun ( "g" , [] - , ALet - ("anf_app#1", AApp (AId "anon$1", []), ACExpr (CImmExpr (AId "anf_app#1"))) + , ALet ("anf_app#1", AApp (AId "anon$1", []), ACExpr (CImmExpr (AId "anf_app#1"))) ) ; AFun ( "anon$2" @@ -472,19 +535,35 @@ let anf6 = ; AFun ( "h" , [ "a" ] - , ALet( "anf_app#3", AApp (AId "a", []) - , ALet( "anf_app#4", AApp (AId "anon$2", [ AId "anf_app#3" ]) - , ACExpr (CImmExpr (AId "anf_app#4")) ) )) + , ALet + ( "anf_app#3" + , AApp (AId "a", []) + , ALet + ( "anf_app#4" + , AApp (AId "anon$2", [ AId "anf_app#3" ]) + , ACExpr (CImmExpr (AId "anf_app#4")) ) ) ) ; AFun ( "f" , [ "a" ] - , ALet( "anf_app#5", AApp (AId "a", []) - , ALet( "anf_app#6", AApp (AId "g", [ AId "anf_app#5" ]) - , ALet( "anf_app#7", AApp (AId "a", []) - , ALet( "anf_app#8", AApp (AId "a", []) - , ALet( "anf_app#9", AApp (AId "h", [ AId "anf_app#7"; AId "anf_app#8" ]) - , ALet( "anf_op#10", AAdd (AId "anf_app#6", AId "anf_app#9") - , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) )))) + , ALet + ( "anf_app#5" + , AApp (AId "a", []) + , ALet + ( "anf_app#6" + , AApp (AId "g", [ AId "anf_app#5" ]) + , ALet + ( "anf_app#7" + , AApp (AId "a", []) + , ALet + ( "anf_app#8" + , AApp (AId "a", []) + , ALet + ( "anf_app#9" + , AApp (AId "h", [ AId "anf_app#7"; AId "anf_app#8" ]) + , ALet + ( "anf_op#10" + , AAdd (AId "anf_app#6", AId "anf_app#9") + , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ) ) ) ) ] ;; diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 6abdf0e23..6197b8bc5 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -193,11 +193,11 @@ in anf_if#4)) ) - (fun anon$1(print_int)-> + (fun anon$2(print_int)-> print_int ) (fun main()-> - (let anf_app#11=(anon$1 ) + (let anf_app#11=(anon$2 ) in (let anf_app#12=(fac_cps 4 anf_app#11) in diff --git a/slarnML/test/exec_test.t_ b/slarnML/test/exec_test.t_ index de4a632606d0355e328b04073feffc018fb44105..7a99674dca979dfc9a383219ff756076fd7e67ae 100644 GIT binary patch literal 7394 zcmeHLS&tJr5PpVVQ4fQdk@`vp1&A2lcAr)Y5|0Q)j@!vtICig(5%cf2%H5r#bC3+M zte~YxZMVC=I$ZUY9e^vSf)*gY2o6>{em{9JliGPZ^TK&}^9KHS_b0psnq?oJ0uGh% zuwqifZJa`UaeV`~P+O@zihC$P>UOn=Pej4z6*y5rD&e`yuWzP#(9+MQ`SSS&{|Y$s zn`y?pw{jl5fS{R@OD(Dy<6JnG06}kk;5_4>XYr#1MiW|GDl=yaX1HWMzGwzh96e!G zCBfAR{?c(tZ(IeIC8No;t8d!5E0R~+(@|1%(?-4^`6$krQs^~0RHLpLt80fK@hwG* z098)`&bJlNbWcGvu(3}`U@w!`V}uffi%&w{^X3)BrS;}z+1ZQUp|Z(~ZoXxIBcKA} z7s<0bdA;7q7>D>JuF#?~y+tx=oJ5T@ER#|66o;cYi~;B((%OYUX^Dmu5gy&{y@)t# zNDK+e?cty{Uo?tW_k`dZi5TOJ+f9u7ZpWxbx2>SOxayKWRZ@p9=~9Q3IY?K`^1EA$ zRk7r4QbKBQw5l@$Bz;#xs*Up%>TO1tvkR#N`n*_Jfz{4*CG`?g4t?|5^v)0!E$n87 zHi?g>uwWibPFQQ~^tkL4{x;wOzXMVW#zG~n;NI8=0y3*wD&{Gcp2Dh`7gdHUm${C+ zpDMl%W4mt~o5=%~nLs(vhJPyqR5iuC)7p46Qdb?!Y17YuS%>U2(kWN}5v!24sv!Lf z^5ATjKpPKm_v!$YzL4dep9D)8f13D_TJ!_4zRUeXEvmdIMhnKXmD=tGZFEd6^l^b* zFKG|U#)31N!G1J{vb?M;cUkI(70@MWen#?^mnLs3@LMG>ERct-V8r~pj`s-q%xpxqqW^F!~>JcjmS=MP?4hy` zUQfP5Wg{D|x$o$hlKbf5Ho&8frV~2SOQtU3i!GsnGj{H>%_(usf2|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 diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index b37060538..22cd2bb4f 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -39,8 +39,8 @@ $ 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))) + (fun anon$2(print_int)->(print_int)) + (fun main()->(let () = ((print_int (fac_cps 4 (anon$2 ))) in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml (fun n1(n)->((n-1))) (fun ab(a b)->((a+b))) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index ebf71ffd0..e50d34806 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -8,17 +8,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall anon_1: @@ -149,17 +149,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall fack: @@ -225,17 +225,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall h: @@ -346,17 +346,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall main: @@ -387,17 +387,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall fac: @@ -467,17 +467,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall anon_1: @@ -553,7 +553,7 @@ ld s0,200(sp) addi sp,sp,224 ret - anon_1: + anon_2: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) @@ -569,10 +569,10 @@ sd ra,136(sp) sd s0,128(sp) addi s0,sp,144 - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) li a2,0 - li a1,3 + li a1,1 call part_app sd a0,-24(s0) lui a0,%hi(fac_cps) @@ -606,17 +606,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall n1: @@ -785,17 +785,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall wrap: @@ -1101,17 +1101,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall fix: @@ -1237,17 +1237,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall anon_1: @@ -1390,17 +1390,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall foo: @@ -1583,17 +1583,17 @@ .attribute stack_align, 16 .global _start _start: - addi sp,sp,-24 + addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) - addi s0,sp,24 + addi s0,sp,32 call init_part_apps call main ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) - addi sp,sp,24 + addi sp,sp,32 li a7,93 ecall anon_2: From 1e2e3e2ddbe05abdf96dc97442ddfd6281c0c2e3 Mon Sep 17 00:00:00 2001 From: Ivan Date: Tue, 8 Apr 2025 12:50:43 +0300 Subject: [PATCH 27/45] Rewrite part app --- slarnML/lib/anf/anf_conv.ml | 2 +- slarnML/lib/anf/lambda_lifting.ml | 43 +- slarnML/lib/riscv64/call_define.ml | 4 + slarnML/lib/riscv64/part_app.c | 275 ++++-- slarnML/lib/riscv64/riscv.ml | 63 +- slarnML/test/anf_conv_test.t | 294 +++--- slarnML/test/dune | 42 +- slarnML/test/exec_test.t_ | Bin 7394 -> 4375 bytes slarnML/test/lambda_lifting_test.t | 36 +- slarnML/test/manytests | 2 +- slarnML/test/riscv64_instr_test.ml | 5 +- slarnML/test/riscv64_instr_test.t | 1378 +++++++--------------------- 12 files changed, 769 insertions(+), 1375 deletions(-) diff --git a/slarnML/lib/anf/anf_conv.ml b/slarnML/lib/anf/anf_conv.ml index 0f8146e90..a82ea1fb6 100644 --- a/slarnML/lib/anf/anf_conv.ml +++ b/slarnML/lib/anf/anf_conv.ml @@ -75,7 +75,7 @@ let rec anf_expr e expr_with_hole = | LIn (id, e1, e2) -> anf_expr e1 (fun limm -> let name = "anf_" ^ get_name id in - ALet (name, AApp (limm, []), anf_expr e2 expr_with_hole)) + ALet (name, CImmExpr limm, anf_expr e2 expr_with_hole)) ;; (* | LApp (id, []) -> expr_with_hole (AId id) *) diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index fb6429e36..0ad3579e4 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -12,15 +12,30 @@ let get_anon_name = map (fun (_, _, _, num) -> Result (String.concat "$" [ "anon"; string_of_int num ])) ;; -let get_name id _ = id -(* String.concat "#" (id :: stack) *) +let get_name id _ = + if String.contains id '#' then String.sub id 0 (String.index id '#') else id +;; + +let replace_fun _ id env = + let base_id = + if String.contains id '#' then String.sub id 0 (String.index id '#') else id + in + let rec find_unique base counter = + let candidate = if counter = 0 then base else base ^ "_" ^ string_of_int counter in + if List.exists (fun (_, name, _) -> name = candidate) env + then find_unique base (counter + 1) + else candidate + in + find_unique base_id 0 +;; 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"]) *) + let base_id = + if String.contains id '#' then String.sub id 0 (String.index id '#') else id + in + match List.find_opt (fun (_, name, _) -> name = id || name = base_id) env with + | None -> Result (LApp (id, [])) | Some (_, _, new_name) -> Result (LId new_name)) ;; @@ -30,7 +45,12 @@ 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_fun name stack lvl = + map (fun (ast, prog, env, num) -> + let new_name = replace_fun name (get_name name stack) env in + Result (ast, prog, (lvl, name, new_name) :: env, num)) +;; + 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) @@ -152,14 +172,7 @@ let rec lifting cc_ast stack lvl res = (res >>= fun r -> Result (r, [])) args >>= fun (r, args) -> - let args = - List.map - (fun a -> - match a with - | LId id -> LApp (id, []) - | e -> e) - (List.rev args) - in + let args = List.rev args in Result r |> lifting e stack lvl |> update_ast (fun a -> diff --git a/slarnML/lib/riscv64/call_define.ml b/slarnML/lib/riscv64/call_define.ml index b9e5cb59a..6f94056eb 100644 --- a/slarnML/lib/riscv64/call_define.ml +++ b/slarnML/lib/riscv64/call_define.ml @@ -1,2 +1,6 @@ +open Riscv_ast + let exit = 93 let default_func = [ "print_int", 1; "print_char", 1 ] +let init_part_apps = Call (Id "init_part_apps") +let part_app = Call (Id "part_app") diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index bbddfe5da..1f8107938 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -5,122 +5,263 @@ #include #include #include +#include -// const uint16_t MAX_APPS = 100; -// const uint8_t MAX_ARGS = 4; +// Maximum number of partial applications to store #define MAX_APPS 100 -#define MAX_ARGS 4 +// Maximum number of arguments per function +#define MAX_ARGS 16 - -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; +// Structure to store function information +struct Func { + uint8_t argscnt; // Total number of arguments the function expects + uint8_t cnt; // Number of arguments already applied + void *ptr; // Function pointer + int64_t *argsfun; // Array of arguments + ffi_cif *cif; // FFI call interface + ffi_type **arg_types; // FFI argument types + void **arg_values; // FFI argument values }; + +// Initialize a new function structure 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; + + // Allocate memory for arguments + new.argsfun = malloc(sizeof(int64_t) * cnt); if (!new.argsfun) { - fprintf(stderr, "Memory allocation failed!"); + fprintf(stderr, "Memory allocation failed for arguments!\n"); exit(1); } - new.cnt = 0; + + // Allocate memory for FFI structures + new.cif = malloc(sizeof(ffi_cif)); + if (!new.cif) { + fprintf(stderr, "Memory allocation failed for FFI CIF!\n"); + free(new.argsfun); + exit(1); + } + + // Allocate memory for argument types + new.arg_types = malloc(sizeof(ffi_type*) * (cnt + 1)); // +1 for return type + if (!new.arg_types) { + fprintf(stderr, "Memory allocation failed for argument types!\n"); + free(new.argsfun); + free(new.cif); + exit(1); + } + + // Allocate memory for argument values + new.arg_values = malloc(sizeof(void*) * cnt); + if (!new.arg_values) { + fprintf(stderr, "Memory allocation failed for argument values!\n"); + free(new.argsfun); + free(new.cif); + free(new.arg_types); + exit(1); + } + + // Set up argument types (all int64_t) + for (int i = 0; i < cnt; i++) { + new.arg_types[i] = &ffi_type_sint64; + } + new.arg_types[cnt] = NULL; // Terminate the array + + // Prepare the FFI call interface + ffi_status status = ffi_prep_cif(new.cif, FFI_DEFAULT_ABI, cnt, &ffi_type_sint64, new.arg_types); + if (status != FFI_OK) { + fprintf(stderr, "Failed to prepare FFI call interface: %d\n", status); + free(new.argsfun); + free(new.cif); + free(new.arg_types); + free(new.arg_values); + exit(1); + } + return new; } + +// Free resources associated with a function +void func_free(struct Func *f) { + if (f) { + free(f->argsfun); + free(f->cif); + free(f->arg_types); + free(f->arg_values); + } +} + +// Global array to store partial applications struct Func *part_apps; +uint8_t *used_apps; uint16_t last_app = 0; +// Apply a function with its stored arguments 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: + if (f == NULL || f->ptr == NULL) { + fprintf(stderr, "Error: NULL pointer in app_n function\n"); return -1; } + + // Set up argument values + for (int i = 0; i < f->argscnt; i++) { + f->arg_values[i] = &f->argsfun[i]; + } + + // Call the function using FFI + int64_t result; + ffi_call(f->cif, FFI_FN(f->ptr), &result, f->arg_values); + + return result; } +// Apply arguments to a function 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]; + if (f == NULL || args == NULL) { + fprintf(stderr, "Error: NULL pointer in app function\n"); + return -1; } - int64_t ret; - if (f->cnt < f->argscnt) { - return (int64_t)f; - } else { - ret = app_n(f); + + uint8_t f_cnt = f->cnt; + uint8_t new_cnt = f_cnt + cnt; + + // Store the new arguments + for (int i = f_cnt; i < new_cnt && i < f->argscnt; i++) { + f->argsfun[i] = args[i - f_cnt]; } - 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]; + + // Update the count of applied arguments + f->cnt = (new_cnt < f->argscnt) ? new_cnt : f->argscnt; + + // If we have all arguments, call the function + if (f->cnt >= f->argscnt) { + int64_t ret = app_n(f); + + // If there are more arguments than needed, create a new partial application + if (new_cnt > f->argscnt) { + int64_t new_args[MAX_ARGS]; + for (int i = 0; i < new_cnt - f->argscnt && i < MAX_ARGS; i++) { + new_args[i] = args[i + (f->argscnt - f_cnt)]; + } + + // Create a new function with the remaining arguments + struct Func *new_f = &part_apps[last_app]; + *new_f = func_init(f->ptr, f->argscnt); + last_app = (last_app + 1) % MAX_APPS; + + return app(new_f, new_cnt - f->argscnt, new_args); } - return app((void*)ret, f_cnt + cnt - f->argscnt, new_args); + + return ret; } - else return ret; + + // Return the function pointer as an integer + return (int64_t)f; } +// Main function for partial application 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++) { + + // Get the arguments from the variable argument list + for (int i = 0; i < appcnt && i < MAX_ARGS; i++) { args[i] = va_arg(argptr, int64_t); } va_end(argptr); + + // Check if f_ptr is a valid function pointer + if (f_ptr == NULL) { + fprintf(stderr, "Error: NULL function pointer\n"); + return -1; + } + + // Check if f_ptr is within the part_apps array if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS-1]) { + // If it's already a partial application, copy it part_apps[last_app] = *(struct Func *)f_ptr; } else { + // Initialize a new function part_apps[last_app] = func_init(f_ptr, argcnt); + used_apps[last_app] = 1; } + + // Update last_app and ensure it's within bounds last_app = (last_app + 1) % MAX_APPS; + + // Call the function with the arguments return app(&part_apps[last_app-1], appcnt, args); } +// Initialize the partial applications array void init_part_apps() { part_apps = malloc(sizeof(struct Func) * MAX_APPS); + if (!part_apps) { + fprintf(stderr, "Failed to allocate memory for part_apps\n"); + exit(1); + } + used_apps = malloc(sizeof(uint8_t) * MAX_APPS); + if (!used_apps) { + fprintf(stderr, "Failed to allocate memory for used_apps\n"); + exit(1); + } + + // Initialize all function pointers to NULL + for (int i = 0; i < MAX_APPS; i++) { + part_apps[i].ptr = NULL; + part_apps[i].argsfun = NULL; + part_apps[i].argscnt = 0; + part_apps[i].cnt = 0; + part_apps[i].cif = NULL; + part_apps[i].arg_types = NULL; + part_apps[i].arg_values = NULL; + used_apps[i] = 0; + } } -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; +// Clean up resources +void cleanup_part_apps() { + if (part_apps) { + for (int i = 0; i < MAX_APPS; i++) { + if (used_apps[i]) { + func_free(&part_apps[i]); + } + } + free(part_apps); + free(used_apps); + } } -int fun ( int a, int b) -{ - return(10*a+b); -} +// // Example function with many arguments +// 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 notmain () -{ - return many_arg(0,1,2,3,4,5,6,7,8,9,10,11,12,13); -} +// // Example function with two arguments +// int fun(int a, int b) { +// return (10 * a + b); +// } + +// // Example function with no arguments +// int notmain() { +// return many_arg(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13); +// } + +// #include +// int not_main() { +// init_part_apps(); +// int64_t a = part_app(notmain, 0, 0); +// int64_t m = part_app(many_arg, 14, 0); +// int64_t m2 = part_app(m, 14, 1, 0); +// int64_t m3 = part_app(m2, 14, 6, 1, 2, 3, 4, 5, 6); +// int64_t m4 = part_app(m3, 0, 7, 7, 8, 9, 10, 11, 12, 13); +// printf("%d %d %d %d %d\n", a, m, m2, m3, m4); +// cleanup_part_apps(); +// return 0; +// } diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index d68d38aa8..fc935a2ee 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -39,9 +39,17 @@ let f_id x = x let get_fun name = map (fun (_, _, _, _, _, funs) -> - Result (List.find_opt (fun (f_name, _) -> f_name = name) funs)) + Result + (List.find_opt + (fun (f_name, _) -> + f_name = name + || (String.length f_name > String.length name + && String.sub f_name 0 (String.length name) = name)) + funs)) ;; +let get_funs = map (fun (_, _, _, _, _, funs) -> Result funs) + let update_funs f = map (fun (offset, regs, offsets, free, conds, funs) -> Result (offset, regs, offsets, free, conds, f funs)) @@ -52,6 +60,17 @@ let add_fun name args_cnt = Result (offset, regs, offsets, free, conds, (name, args_cnt) :: funs)) ;; +let replace_fun name args_cnt = + map (fun (offset, regs, offsets, free, conds, funs) -> + Result + ( offset + , regs + , offsets + , free + , conds + , (name, args_cnt) :: List.filter (fun (f_name, _) -> f_name <> name) funs )) +;; + let rec count_max_call_offset offset a = let count_offset_cexpr = function | ANot _ @@ -378,7 +397,21 @@ let load_imm f a res = | AUnit -> load_const (fun _ -> []) ;; -let filter_tag = String.map (fun c -> if c = '#' || c = '$' then '_' else c) +let filter_tag tag = + if tag = "main" + then tag ^ "2" + else String.map (fun c -> if c = '#' || c = '$' then '_' else c) tag +;; + +let get_unique_tag id env = + let rec find_unique base counter = + let candidate = if counter = 0 then base else base ^ "_" ^ string_of_int counter in + if List.exists (fun (f_name, _) -> f_name = candidate) env + then find_unique base (counter + 1) + else candidate + in + if id = "main" then "main" else find_unique id 0 +;; let rec build_aexpr tag a res = let f o = o - 8 in @@ -576,7 +609,12 @@ let init_fun anf res = let offset_full = offset_call + offset_args + offset_expr + offset_reserved in let offset_align = 16 * ((offset_full + 15) / 16) in res - |> add_fun id (List.length args) + |> get_funs + >>= fun funs -> + let unique_id = get_unique_tag id funs in + let args_cnt = List.length args in + let res = res |> add_fun unique_id args_cnt in + res |> save_args (-offset_full) args >>= fun (s_argsi, env) -> Result ([], None, env) @@ -586,7 +624,7 @@ let init_fun anf res = | None -> Error "Void?" | Some reg -> Result - ( (Tag (filter_tag id) + ( (Tag (filter_tag unique_id) :: [ Mathi (Add, Sp, Sp, ImmInt (-offset_align)) ; Sd (Ra, ImmInt (offset_full - 8), Sp) ; Sd (S 0, ImmInt (offset_full - 16), Sp) @@ -600,21 +638,24 @@ let init_fun anf res = ; Mathi (Add, Sp, Sp, ImmInt offset_align) ; Ret ] - , [ id, List.length args ] )) + , [ unique_id, args_cnt ] )) ;; let head = [ Attribute "unaligned_access, 0" ; Attribute "stack_align, 16" - ; Global "_start" - ; Tag "_start" + ; Global "main" + ; Tag "main" ; Mathi (Add, Sp, Sp, ImmInt (-32)) ; Sd (Ra, ImmInt 16, Sp) ; Sd (S 0, ImmInt 8, Sp) ; Sd (S 1, ImmInt 0, Sp) ; Mathi (Add, S 0, Sp, ImmInt 32) ; Call (Id "init_part_apps") - ; Call (Id "main") + ; Call (Id "main2") + ; Sd (A 0, ImmInt 24, Sp) + ; Call (Id "cleanup_part_apps") + ; Ld (A 0, ImmInt 24, Sp) ; Ld (Ra, ImmInt 16, Sp) ; Ld (S 0, ImmInt 8, Sp) ; Ld (S 1, ImmInt 0, Sp) @@ -626,7 +667,7 @@ let head = let default_res = Result - ( -24 + ( -32 , [] , [] , [ 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 ] @@ -634,10 +675,6 @@ let default_res = , 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 -> diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 6197b8bc5..cbd5ad0ea 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -5,48 +5,40 @@ > ;; > EOF (fun anon$1(n f x)-> - (let anf_app#1=(n ) + (let anf_app#1=(f n) in - (let anf_app#2=(f anf_app#1) + (let anf_op#2=(x*anf_app#1) in - (let anf_op#3=(x*anf_app#2) - in - anf_op#3))) + anf_op#2)) ) (fun fack(n f)-> - (let anf_op#4=(n<=1) + (let anf_op#3=(n<=1) in - (let anf_if#5=if (anf_op#4) + (let anf_if#4=if (anf_op#3) then ( - (let anf_app#6=(f 1) + (let anf_app#5=(f 1) in - anf_app#6) + anf_app#5) ) else ( - (let anf_op#7=(n-1) - in - (let anf_app#8=(n ) - in - (let anf_app#9=(f ) + (let anf_op#6=(n-1) in - (let anf_app#10=(anon$1 anf_app#8 anf_app#9) + (let anf_app#7=(anon$1 n f) in - (let anf_app#11=(fack anf_op#7 anf_app#10) + (let anf_app#8=(fack anf_op#6 anf_app#7) in - anf_app#11)))))) + anf_app#8)))) in - anf_if#5)) + anf_if#4)) ) (fun anon$2(x)-> x ) (fun fac(n)-> - (let anf_app#12=(n ) + (let anf_app#9=(anon$2 ) in - (let anf_app#13=(anon$2 ) + (let anf_app#10=(fack n anf_app#9) in - (let anf_app#14=(fack anf_app#12 anf_app#13) - in - anf_app#14))) + anf_app#10)) ) $ dune exec anf_conv_test << EOF > let fac n = @@ -72,11 +64,9 @@ anf_if#2)) ) (fun fac(n)-> - (let anf_app#6=(n ) + (let anf_app#6=(fack n) in - (let anf_app#7=(fack anf_app#6) - in - anf_app#7)) + anf_app#6) ) $ dune exec anf_conv_test << EOF > let f a = @@ -104,22 +94,14 @@ 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=(h anf_app#8 anf_app#9 anf_app#10 4) + (let anf_app#8=(h a c d 4) in - anf_app#11)))) + anf_app#8) ) (fun f(a)-> - (let anf_app#12=(a ) + (let anf_app#9=(g a 2 3) in - (let anf_app#13=(g anf_app#12 2 3) - in - anf_app#13)) + anf_app#9) ) $ dune exec anf_conv_test < manytests/do_not_type/001.ml fac not exist @@ -158,7 +140,7 @@ in (let anf_app#7=(print_int anf_app#6) in - (let anf_()#8=(anf_app#7 ) + (let anf_()#8=anf_app#7 in 0))) ) @@ -181,15 +163,11 @@ ) 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) + (let anf_app#7=(anon$1 n k) in - (let anf_app#10=(fac_cps anf_op#6 anf_app#9) + (let anf_app#8=(fac_cps anf_op#6 anf_app#7) in - anf_app#10)))))) + anf_app#8)))) in anf_if#4)) ) @@ -197,13 +175,13 @@ print_int ) (fun main()-> - (let anf_app#11=(anon$2 ) + (let anf_app#9=(anon$2 ) in - (let anf_app#12=(fac_cps 4 anf_app#11) + (let anf_app#10=(fac_cps 4 anf_app#9) in - (let anf_app#13=(print_int anf_app#12) + (let anf_app#11=(print_int anf_app#10) in - (let anf_()#14=(anf_app#13 ) + (let anf_()#12=anf_app#11 in 0)))) ) @@ -225,51 +203,45 @@ then ( b ) else ( - (let anf_app#5=(b ) - in - (let anf_app#6=(ab ) - in - (let anf_app#7=(n1 ) + (let anf_app#5=(fib_acc b ab n1) in - (let anf_app#8=(fib_acc anf_app#5 anf_app#6 anf_app#7) - in - anf_app#8))))) + anf_app#5)) in anf_if#4)) ) (fun fib(n)-> - (let anf_op#9=(n<2) + (let anf_op#6=(n<2) in - (let anf_if#10=if (anf_op#9) + (let anf_if#7=if (anf_op#6) then ( n ) else ( - (let anf_op#11=(n-1) + (let anf_op#8=(n-1) in - (let anf_op#12=(n-2) + (let anf_op#9=(n-2) in - (let anf_app#13=(fib anf_op#12) + (let anf_app#10=(fib anf_op#9) in - (let anf_op#14=(anf_op#11+anf_app#13) + (let anf_op#11=(anf_op#8+anf_app#10) in - (let anf_app#15=(fib anf_op#14) + (let anf_app#12=(fib anf_op#11) in - anf_app#15)))))) + anf_app#12)))))) in - anf_if#10)) + anf_if#7)) ) (fun main()-> - (let anf_app#16=(fib_acc 0 1 4) + (let anf_app#13=(fib_acc 0 1 4) in - (let anf_app#17=(print_int anf_app#16) + (let anf_app#14=(print_int anf_app#13) in - (let anf_()#18=(anf_app#17 ) + (let anf_()#15=anf_app#14 in - (let anf_app#19=(fib 4) + (let anf_app#16=(fib 4) in - (let anf_app#20=(print_int anf_app#19) + (let anf_app#17=(print_int anf_app#16) in - (let anf_()#21=(anf_app#20 ) + (let anf_()#18=anf_app#17 in 0)))))) ) @@ -290,136 +262,124 @@ anf_if#2)) ) (fun a(a)-> - (let anf_app#5=(a ) - in - (let anf_app#6=(print_int anf_app#5) + (let anf_app#5=(print_int a) in - anf_app#6)) + anf_app#5) ) (fun b(b)-> - (let anf_app#7=(b ) + (let anf_app#6=(print_int b) in - (let anf_app#8=(print_int anf_app#7) - in - anf_app#8)) + anf_app#6) ) (fun c(c)-> - (let anf_app#9=(c ) + (let anf_app#7=(print_int c) in - (let anf_app#10=(print_int anf_app#9) - in - anf_app#10)) + anf_app#7) ) (fun test3(a b c)-> 0 ) (fun test10(a b c d e f g h i j)-> - (let anf_app#11=(a ) + (let anf_app#8=(a ) in - (let anf_app#12=(b ) + (let anf_app#9=(b ) in - (let anf_op#13=(anf_app#11+anf_app#12) + (let anf_op#10=(anf_app#8+anf_app#9) in - (let anf_app#14=(c ) + (let anf_app#11=(c ) in - (let anf_op#15=(anf_op#13+anf_app#14) + (let anf_op#12=(anf_op#10+anf_app#11) in - (let anf_app#16=(d ) + (let anf_app#13=(d ) in - (let anf_op#17=(anf_op#15+anf_app#16) + (let anf_op#14=(anf_op#12+anf_app#13) in - (let anf_app#18=(e ) + (let anf_app#15=(e ) in - (let anf_op#19=(anf_op#17+anf_app#18) + (let anf_op#16=(anf_op#14+anf_app#15) in - (let anf_app#20=(f ) + (let anf_app#17=(f ) in - (let anf_op#21=(anf_op#19+anf_app#20) + (let anf_op#18=(anf_op#16+anf_app#17) in - (let anf_app#22=(g ) + (let anf_app#19=(g ) in - (let anf_op#23=(anf_op#21+anf_app#22) + (let anf_op#20=(anf_op#18+anf_app#19) in - (let anf_app#24=(h ) + (let anf_app#21=(h ) in - (let anf_op#25=(anf_op#23+anf_app#24) + (let anf_op#22=(anf_op#20+anf_app#21) in - (let anf_app#26=(i ) + (let anf_app#23=(i ) in - (let anf_op#27=(anf_op#25+anf_app#26) + (let anf_op#24=(anf_op#22+anf_app#23) in - (let anf_app#28=(j ) + (let anf_app#25=(j ) in - (let anf_op#29=(anf_op#27+anf_app#28) + (let anf_op#26=(anf_op#24+anf_app#25) in - anf_op#29))))))))))))))))))) + anf_op#26))))))))))))))))))) ) (fun rez()-> - (let anf_app#30=(test10 ) + (let anf_app#27=(test10 ) in - (let anf_app#31=(wrap anf_app#30 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#28=(wrap anf_app#27 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - anf_app#31)) + anf_app#28)) ) (fun temp2()-> - (let anf_app#32=(test3 ) + (let anf_app#29=(test3 ) in - (let anf_app#33=(wrap anf_app#32 1 10 100) + (let anf_app#30=(wrap anf_app#29 1 10 100) in - anf_app#33)) + anf_app#30)) ) (fun main()-> - (let anf_app#34=(rez ) - in - (let anf_app#35=(print_int anf_app#34) + (let anf_app#31=(print_int rez) in - (let anf_()#36=(anf_app#35 ) + (let anf_()#32=anf_app#31 in - 0))) + 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) + (let anf_app#1=(fix f) in - (let anf_app#3=(x ) + (let anf_app#2=(f anf_app#1 x) in - (let anf_app#4=(f anf_app#2 anf_app#3) - in - anf_app#4)))) + anf_app#2)) ) (fun fac(self n)-> - (let anf_app#5=(n ) + (let anf_app#3=(n ) in - (let anf_op#6=(anf_app#5<=1) + (let anf_op#4=(anf_app#3<=1) in - (let anf_if#7=if (anf_op#6) + (let anf_if#5=if (anf_op#4) then ( 1 ) else ( - (let anf_app#8=(n ) + (let anf_app#6=(n ) in - (let anf_app#9=(n ) + (let anf_app#7=(n ) in - (let anf_op#10=(anf_app#9-1) + (let anf_op#8=(anf_app#7-1) in - (let anf_app#11=(self anf_op#10) + (let anf_app#9=(self anf_op#8) in - (let anf_op#12=(anf_app#8*anf_app#11) + (let anf_op#10=(anf_app#6*anf_app#9) in - anf_op#12)))))) + anf_op#10)))))) in - anf_if#7))) + anf_if#5))) ) (fun main()-> - (let anf_app#13=(fac ) + (let anf_app#11=(fac ) in - (let anf_app#14=(fix anf_app#13 6) + (let anf_app#12=(fix anf_app#11 6) in - (let anf_app#15=(print_int anf_app#14) + (let anf_app#13=(print_int anf_app#12) in - (let anf_()#16=(anf_app#15 ) + (let anf_()#14=anf_app#13 in 0)))) ) @@ -467,7 +427,7 @@ in (let anf_app#13=(print_int anf_app#12) in - (let anf_()#14=(anf_app#13 ) + (let anf_()#14=anf_app#13 in 0))) ) @@ -477,19 +437,19 @@ in (let anf_app#2=(print_int anf_app#1) in - (let anf_()#3=(anf_app#2 ) + (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 ) + (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 ) + (let anf_()#9=anf_app#8 in (let anf_app#10=(a ) in @@ -509,62 +469,52 @@ anf_app#15) ) (fun foo(foo)-> - (let anf_app#16=(foo ) - in - (let anf_app#17=(foo anf_app#16 2) + (let anf_app#16=(foo_1 foo_1 2) in - anf_app#17)) + anf_app#16) ) (fun foo(foo)-> - (let anf_app#18=(foo ) + (let anf_app#17=(foo_1 foo_1 3) in - (let anf_app#19=(foo anf_app#18 3) - in - anf_app#19)) + anf_app#17) ) (fun main()-> - (let anf_app#20=(foo ) - in - (let anf_app#21=(print_int anf_app#20) + (let anf_app#18=(print_int foo) in - (let anf_()#22=(anf_app#21 ) + (let anf_()#19=anf_app#18 in - 0))) + 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) + (let anf_app#1=(print_int c) in - anf_app#2)) + anf_app#1) ) (fun anon$1(b)-> - (let anf_app#3=(b ) - in - (let anf_app#4=(print_int anf_app#3) + (let anf_app#2=(print_int b) in - (let anf_()#5=(anf_app#4 ) + (let anf_()#3=anf_app#2 in - (let anf_app#6=(anon$2 ) + (let anf_app#4=(anon$2 ) in - anf_app#6)))) + anf_app#4))) ) (fun foo(a)-> - (let anf_app#7=(a ) + (let anf_app#5=(a ) in - (let anf_app#8=(print_int anf_app#7) + (let anf_app#6=(print_int anf_app#5) in - (let anf_()#9=(anf_app#8 ) + (let anf_()#7=anf_app#6 in - (let anf_app#10=(anon$1 ) + (let anf_app#8=(anon$1 ) in - anf_app#10)))) + anf_app#8)))) ) (fun main()-> - (let anf_app#11=(foo 4 8 9) + (let anf_app#9=(foo 4 8 9) in - (let anf_()#12=(anf_app#11 ) + (let anf_()#10=anf_app#9 in 0)) ) diff --git a/slarnML/test/dune b/slarnML/test/dune index 98235cf6a..816bd0ee8 100644 --- a/slarnML/test/dune +++ b/slarnML/test/dune @@ -133,23 +133,25 @@ 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 + print.S + part_app.c + ../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_ index 7a99674dca979dfc9a383219ff756076fd7e67ae..67788e52c0a24e5ad4b746ffe34fe0111395297a 100644 GIT binary patch literal 4375 zcmeHKU2EGg6y5WF#eFEWrO2|KQfO%Vw!vV~hdh>%DzcObWGR!SlK%T$`6D0hm)mr- zgM<*vv32j2bac)UzyTD&2oOub!KsShot;jVsl1zdQF*wyfN$5|;R@niGWiPF)WSo_ zl!43o7V1Baj^Pp(P8pBgJ*1#a`!ubu7zM8fT@Ip^2}?3Jfv^fl$sGTE=`i`6x2b?w zY?X_|4(*pDRI3?nM?vdil1YryG@lAI=e$<|xz2(7prLY9Th269hU-uWAU`+$#AHCU zlnQ?_LgkrPc;(P9ggHNDi$#JDv6k-c73El9i4A_EZ#SfNiUt%`&*C3Z2GULt_JMjd z?frU5a14t8aWx>Jb!P0GerY~+oaZrv=rH#YFctOp3sKNC%_QSVsW*YN$HK;XK7sK^ zp!pfFke}{?g?x{NNV9as1phTJOvJntCUT!OAX(5Jj<|IKb*03;e~ie!$wueD-o_gv zsb)RiU^6h*gS5dEPi&jLq#(Z5d`|uyjWlwIs*5QIcebiJ{avT0*@&VfuD%cShR&3s zx)?Wd6g7OOXfXhHK1=KvT?oivcn!|mDN3~Shhs#|QR2nYpQOt?KOO@jNl0Zx0ZvHa zgy90bh1=+I4)JYnwHDmxV-U_+HwGQw^ufh08JZ{MAtxq(BTOMpk)JNbN4Vkf(FKW{jTR2duv_SJHr4wj2 zm?@N*zrug@OX+6)0X_*XceHq|jqE(viob32b&W&o%~==nBe9V8z#y%iX1h~pfA$7p zY!8pEE%h1TG3vo%&^k7!!Tk|!b!J@=zy>Mw=;GzGBa-a<>S=R+?x`R%)=aZ)6+Gw9 Vs340H_`Zd$x{CH@HQ{R<8oj2i#| literal 7394 zcmeHLS&tJr5PpVVQ4fQdk@`vp1&A2lcAr)Y5|0Q)j@!vtICig(5%cf2%H5r#bC3+M zte~YxZMVC=I$ZUY9e^vSf)*gY2o6>{em{9JliGPZ^TK&}^9KHS_b0psnq?oJ0uGh% zuwqifZJa`UaeV`~P+O@zihC$P>UOn=Pej4z6*y5rD&e`yuWzP#(9+MQ`SSS&{|Y$s zn`y?pw{jl5fS{R@OD(Dy<6JnG06}kk;5_4>XYr#1MiW|GDl=yaX1HWMzGwzh96e!G zCBfAR{?c(tZ(IeIC8No;t8d!5E0R~+(@|1%(?-4^`6$krQs^~0RHLpLt80fK@hwG* z098)`&bJlNbWcGvu(3}`U@w!`V}uffi%&w{^X3)BrS;}z+1ZQUp|Z(~ZoXxIBcKA} z7s<0bdA;7q7>D>JuF#?~y+tx=oJ5T@ER#|66o;cYi~;B((%OYUX^Dmu5gy&{y@)t# zNDK+e?cty{Uo?tW_k`dZi5TOJ+f9u7ZpWxbx2>SOxayKWRZ@p9=~9Q3IY?K`^1EA$ zRk7r4QbKBQw5l@$Bz;#xs*Up%>TO1tvkR#N`n*_Jfz{4*CG`?g4t?|5^v)0!E$n87 zHi?g>uwWibPFQQ~^tkL4{x;wOzXMVW#zG~n;NI8=0y3*wD&{Gcp2Dh`7gdHUm${C+ zpDMl%W4mt~o5=%~nLs(vhJPyqR5iuC)7p46Qdb?!Y17YuS%>U2(kWN}5v!24sv!Lf z^5ATjKpPKm_v!$YzL4dep9D)8f13D_TJ!_4zRUeXEvmdIMhnKXmD=tGZFEd6^l^b* zFKG|U#)31N!G1J{vb?M;cUkI(70@MWen#?^mnLs3@LMG>ERct-V8r~pj`s-q%xpxqqW^F!~>JcjmS=MP?4hy` zUQfP5Wg{D|x$o$hlKbf5Ho&8frV~2SOQtU3i!GsnGj{H>%_(u (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$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)->((fack (n ) (anon$2 )))) + (fun fac(n)->((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 @@ -15,7 +15,7 @@ > ;; > EOF (fun fack(n)->(if ((n<1)) then (n) else ((n*(fack (n-1)))))) - (fun fac(n)->((fack (n )))) + (fun fac(n)->((fack n))) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -25,8 +25,8 @@ > (g 2 3) > EOF (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) - (fun g(a c d)->((h (a ) (c ) (d ) 4))) - (fun f(a)->((g (a ) 2 3))) + (fun g(a c d)->((h a c d 4))) + (fun f(a)->((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 @@ -38,27 +38,27 @@ (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 fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon$1 n k))))) (fun anon$2(print_int)->(print_int)) (fun main()->(let () = ((print_int (fac_cps 4 (anon$2 ))) in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml (fun n1(n)->((n-1))) (fun ab(a b)->((a+b))) - (fun fib_acc(a b n)->(if ((n=1)) then (b) else ((fib_acc (b ) (ab ) (n1 ))))) + (fun fib_acc(a b n)->(if ((n=1)) then (b) else ((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 )))) - (fun b(b)->((print_int (b )))) - (fun c(c)->((print_int (c )))) + (fun a(a)->((print_int a))) + (fun b(b)->((print_int b))) + (fun c(c)->((print_int c))) (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 rez()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) (fun temp2()->((wrap (test3 ) 1 10 100))) - (fun main()->(let () = ((print_int (rez )) in 0))) + (fun main()->(let () = ((print_int rez) in 0))) $ dune exec lambda_lifting_test < manytests/typed/005fix.ml - (fun fix(f x)->((f (fix (f )) (x )))) + (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 @@ -70,12 +70,12 @@ $ 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 () = ((print_int (foo )) in 0))) + (fun foo(foo)->((foo_1 foo_1 2))) + (fun foo(foo)->((foo_1 foo_1 3))) + (fun main()->(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 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 diff --git a/slarnML/test/manytests b/slarnML/test/manytests index 0bd48791d..34b5bbb13 120000 --- a/slarnML/test/manytests +++ b/slarnML/test/manytests @@ -1 +1 @@ -../../manytests \ No newline at end of file +../../../manytests \ No newline at end of file diff --git a/slarnML/test/riscv64_instr_test.ml b/slarnML/test/riscv64_instr_test.ml index ca6288235..b7591dc5c 100644 --- a/slarnML/test/riscv64_instr_test.ml +++ b/slarnML/test/riscv64_instr_test.ml @@ -12,9 +12,8 @@ let () = >>= (fun anf -> SlarnML_lib.Riscv.asm anf) >>= fun prog -> Result - (String.concat - "\n" - (List.map (SlarnML_lib.Pprint_riscv.pp_instruction "\t") prog)) + (String.concat "\n" (List.map (SlarnML_lib.Pprint_riscv.pp_instruction "\t") prog) + ^ "\n") | Error message -> SlarnML_lib.Res.Error message in match result with diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index e50d34806..5c7c9ef57 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -6,15 +6,18 @@ > EOF .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) @@ -22,82 +25,68 @@ li a7,93 ecall anon_1: - addi sp,sp,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 - sd a2,-112(s0) - sd a1,-104(s0) - sd a0,-96(s0) - ld a0,-96(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) - ld a0,-104(s0) - ld a3,-24(s0) + 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,-112(s0) + ld a1,-80(s0) mul a2,a1,a0 mv a0,a2 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 ret fack: - addi sp,sp,-224 - sd ra,208(sp) - sd s0,200(sp) - addi s0,sp,224 - sd a1,-216(s0) - sd a0,-208(s0) + 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_4 - ld a0,-216(s0) + ble t0,a0,.tag_anf_op_3 + lui a0,%hi(f) + addi a0,a0,%lo(f) li a3,1 li a2,1 - li a1,0 + li a1,2 call part_app - j .tag_anf_op_4_t - .tag_anf_op_4: - ld t0,-208(s0) + 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) - 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) + sd a0,-32(s0) + sd t1,-40(s0) lui a0,%hi(anon_1) addi a0,a0,%lo(anon_1) - ld a4,-48(s0) - ld a3,-40(s0) + ld a4,-152(s0) + ld a3,-144(s0) li a2,2 li a1,3 call part_app - sd a0,-56(s0) + sd a0,-48(s0) lui a0,%hi(fack) addi a0,a0,%lo(fack) - ld a4,-56(s0) - ld a3,-32(s0) + ld a4,-48(s0) + ld a3,-40(s0) li a2,2 li a1,2 call part_app - .tag_anf_op_4_t: - sd a0,-64(s0) + .tag_anf_op_3_t: + sd a0,-56(s0) mv a0,a0 - ld ra,208(sp) - ld s0,200(sp) - addi sp,sp,224 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret anon_2: addi sp,sp,-32 @@ -111,16 +100,11 @@ addi sp,sp,32 ret fac: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - sd a0,-120(s0) - ld a0,-120(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-24(s0) + 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) addi a0,a0,%lo(anon_2) li a2,0 @@ -130,14 +114,14 @@ lui a0,%hi(fack) addi a0,a0,%lo(fack) ld a4,-32(s0) - ld a3,-24(s0) + ld a3,-88(s0) li a2,2 li a1,2 call part_app mv a0,a0 - ld ra,112(sp) - ld s0,104(sp) - addi sp,sp,128 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 ret $ dune exec riscv64_instr_test << EOF > let fac n = @@ -147,15 +131,18 @@ > EOF .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) @@ -174,16 +161,16 @@ .tag_anf_op_1: li t1,1 sub t2,a0,t1 - sd t2,-24(s0) + sd t2,-32(s0) lui a0,%hi(fack) addi a0,a0,%lo(fack) - ld a3,-24(s0) + ld a3,-32(s0) li a2,1 li a1,1 call part_app ld t2,-88(s0) mul t1,t2,a0 - sd a0,-32(s0) + sd a0,-40(s0) mv a0,t1 .tag_anf_op_1_t: mv a0,a0 @@ -192,26 +179,21 @@ addi sp,sp,96 ret fac: - 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) + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) lui a0,%hi(fack) addi a0,a0,%lo(fack) - ld a3,-24(s0) + ld a3,-56(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 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 ret $ dune exec riscv64_instr_test << EOF > let f a = @@ -223,15 +205,18 @@ > EOF .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) @@ -251,26 +236,26 @@ li a2,0 li a1,0 call part_app - sd a0,-24(s0) + sd a0,-32(s0) ld a0,-184(s0) li a2,0 li a1,0 call part_app - sd a0,-32(s0) + sd a0,-40(s0) ld a0,-192(s0) li a2,0 li a1,0 call part_app - sd a0,-40(s0) + sd a0,-48(s0) ld a0,-200(s0) li a2,0 li a1,0 call part_app - ld a1,-40(s0) + ld a1,-48(s0) mul a2,a1,a0 - ld a3,-32(s0) + ld a3,-40(s0) add t0,a3,a2 - ld t1,-24(s0) + ld t1,-32(s0) mul t2,t1,t0 mv a0,t2 ld ra,192(sp) @@ -278,65 +263,45 @@ addi sp,sp,208 ret g: - addi sp,sp,-176 - sd ra,160(sp) - sd s0,152(sp) - addi s0,sp,176 - sd a2,-168(s0) - 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) - ld a0,-160(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-32(s0) - ld a0,-168(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) + 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) addi a0,a0,%lo(h) li a6,4 - ld a5,-40(s0) - ld a4,-32(s0) - ld a3,-24(s0) + 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,160(sp) - ld s0,152(sp) - addi sp,sp,176 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 ret f: - 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) + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-56(s0) lui a0,%hi(g) addi a0,a0,%lo(g) li a5,3 li a4,2 - ld a3,-24(s0) + ld a3,-56(s0) li a2,3 li a1,3 call part_app mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 ret $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml fac not exist @@ -344,22 +309,25 @@ $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) addi sp,sp,32 li a7,93 ecall - main: + main2: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) @@ -385,15 +353,18 @@ $ dune exec riscv64_instr_test < manytests/typed/001fac.ml .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) @@ -415,16 +386,16 @@ ld a0,-88(s0) li t2,1 sub t3,a0,t2 - sd t3,-24(s0) + sd t3,-32(s0) lui a0,%hi(fac) addi a0,a0,%lo(fac) - ld a3,-24(s0) + ld a3,-32(s0) li a2,1 li a1,1 call part_app ld t3,-88(s0) mul t2,t3,a0 - sd a0,-32(s0) + sd a0,-40(s0) mv a0,t2 .tag_anf_op_1_t: mv a0,a0 @@ -432,48 +403,47 @@ 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 + main2: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 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) + sd a0,-32(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-24(s0) + ld a3,-32(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) li t0,0 mv a0,t0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 ret $ dune exec riscv64_instr_test < manytests/typed/002fac.ml .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) @@ -489,9 +459,9 @@ sd a1,-72(s0) sd a0,-64(s0) mul t0,a2,a0 - sd t0,-24(s0) + sd t0,-32(s0) ld a0,-72(s0) - ld a3,-24(s0) + ld a3,-32(s0) li a2,1 li a1,0 call part_app @@ -501,57 +471,47 @@ 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) + 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,-216(s0) + 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,-208(s0) + ld t0,-144(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) + sd a0,-32(s0) + sd t1,-40(s0) lui a0,%hi(anon_1) addi a0,a0,%lo(anon_1) - ld a4,-48(s0) - ld a3,-40(s0) + ld a4,-152(s0) + ld a3,-144(s0) li a2,2 li a1,3 call part_app - sd a0,-56(s0) + sd a0,-48(s0) lui a0,%hi(fac_cps) addi a0,a0,%lo(fac_cps) - ld a4,-56(s0) - ld a3,-32(s0) + ld a4,-48(s0) + ld a3,-40(s0) li a2,2 li a1,2 call part_app .tag_anf_op_3_t: - sd a0,-64(s0) + sd a0,-56(s0) mv a0,a0 - ld ra,208(sp) - ld s0,200(sp) - addi sp,sp,224 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret anon_2: addi sp,sp,-32 @@ -564,686 +524,186 @@ 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 + main2: + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 lui a0,%hi(anon_2) addi a0,a0,%lo(anon_2) li a2,0 li a1,1 call part_app - sd a0,-24(s0) + sd a0,-32(s0) lui a0,%hi(fac_cps) addi a0,a0,%lo(fac_cps) - ld a4,-24(s0) + ld a4,-32(s0) li a3,4 li a2,2 li a1,2 call part_app - sd a0,-32(s0) + sd a0,-40(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-32(s0) + ld a3,-40(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 + sd a0,-48(s0) li t0,0 mv a0,t0 - ld ra,136(sp) - ld s0,128(sp) - addi sp,sp,144 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 ret $ dune exec riscv64_instr_test < manytests/typed/003fib.ml + ab not found + + $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml + rez not found + + $ dune exec riscv64_instr_test < manytests/typed/005fix.ml .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) addi sp,sp,32 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) + 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,-32(s0) - add t0,a0,a1 - mv a0,t0 - ld ra,32(sp) - ld s0,24(sp) - addi sp,sp,48 + lui a0,%hi(f) + addi a0,a0,%lo(f) + ld a4,-96(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 ret - fib_acc: + fac: addi sp,sp,-192 - sd ra,176(sp) - sd s0,168(sp) + sd ra,184(sp) + sd s0,176(sp) addi s0,sp,192 - sd a2,-184(s0) - sd a1,-176(s0) - sd a0,-168(s0) - li t0,1 - beq a2,t0,.tag_anf_op_3 - mv a0,a1 - j .tag_anf_op_3_t - .tag_anf_op_3: - ld a0,-176(s0) + sd a1,-192(s0) + sd a0,-184(s0) + ld a0,-192(s0) li a2,0 li a1,0 call part_app - sd a0,-24(s0) - lui a0,%hi(ab) - addi a0,a0,%lo(ab) - li a2,0 - li a1,2 - call part_app - sd a0,-32(s0) - lui a0,%hi(n1) - addi a0,a0,%lo(n1) - li a2,0 - li a1,1 - call part_app - sd a0,-40(s0) - lui a0,%hi(fib_acc) - addi a0,a0,%lo(fib_acc) - ld a5,-40(s0) - ld a4,-32(s0) - ld a3,-24(s0) - li a2,3 - li a1,3 - call part_app - .tag_anf_op_3_t: - sd a0,-48(s0) - mv a0,a0 - ld ra,176(sp) - ld s0,168(sp) - addi sp,sp,192 - 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_9 - j .tag_anf_op_9_t - .tag_anf_op_9: - 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_9_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 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - 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) + ble a1,a0,.tag_anf_op_4 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,-48 - sd ra,32(sp) - sd s0,24(sp) - addi s0,sp,48 - sd a2,-40(s0) - sd a1,-32(s0) - sd a0,-24(s0) - li t0,0 - mv a0,t0 - ld ra,32(sp) - ld s0,24(sp) - addi sp,sp,48 - 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 - rez: - 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 - 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,-112 - sd ra,104(sp) - sd s0,96(sp) - addi s0,sp,112 - lui a0,%hi(rez) - addi a0,a0,%lo(rez) - 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 - 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/005fix.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global _start - _start: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - 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: + j .tag_anf_op_4_t + .tag_anf_op_4: ld a0,-192(s0) li a2,0 li a1,0 call part_app - sd a0,-32(s0) + sd a0,-40(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) + sd a0,-48(s0) + sd a1,-56(s0) ld a0,-184(s0) - ld a3,-48(s0) + ld a3,-56(s0) li a2,1 li a1,0 call part_app - ld a1,-32(s0) + ld a1,-40(s0) mul t0,a1,a0 - sd a0,-56(s0) + sd a0,-64(s0) mv a0,t0 - .tag_anf_op_6_t: + .tag_anf_op_4_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 + main2: + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 lui a0,%hi(fac) addi a0,a0,%lo(fac) li a2,0 li a1,2 call part_app - sd a0,-24(s0) + sd a0,-32(s0) lui a0,%hi(fix) addi a0,a0,%lo(fix) li a4,6 - ld a3,-24(s0) + ld a3,-32(s0) li a2,2 li a1,2 call part_app - sd a0,-32(s0) + sd a0,-40(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-32(s0) + ld a3,-40(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 + sd a0,-48(s0) li t0,0 mv a0,t0 - ld ra,136(sp) - ld s0,128(sp) - addi sp,sp,144 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 ret $ dune exec riscv64_instr_test < manytests/typed/006partial.ml .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) @@ -1287,7 +747,7 @@ li a1,0 call part_app beqz a0,.tag_if_bnch - sd a0,-24(s0) + sd a0,-32(s0) lui a0,%hi(anon_1) addi a0,a0,%lo(anon_1) li a2,0 @@ -1295,20 +755,20 @@ call part_app j .tag_if_bnch_t .tag_if_bnch: - sd a0,-32(s0) + sd a0,-40(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) + sd a0,-48(s0) mv a0,a0 ld ra,120(sp) ld s0,112(sp) addi sp,sp,128 ret - foo: + foo_1: addi sp,sp,-192 sd ra,176(sp) sd s0,168(sp) @@ -1317,20 +777,12 @@ 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 a3,0 li a2,2 li a1,1 call part_app @@ -1338,7 +790,7 @@ lui a0,%hi(foo) addi a0,a0,%lo(foo) ld a4,-40(s0) - li a3,0 + li a3,1 li a2,2 li a1,1 call part_app @@ -1346,250 +798,67 @@ lui a0,%hi(foo) addi a0,a0,%lo(foo) ld a4,-48(s0) - li a3,1 + li a3,0 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,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - 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) + ld a4,-56(s0) 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 + ld ra,176(sp) + ld s0,168(sp) + addi sp,sp,192 ret - foo: + main2: 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 a3,11 + 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 - 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 a2,0 - li a1,3 - call part_app - sd a0,-24(s0) + sd a0,-32(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-24(s0) + ld a3,-32(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) li t0,0 mv a0,t0 - ld ra,104(sp) - ld s0,96(sp) - addi sp,sp,112 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 ret + $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml + foo_1 not found + $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml .attribute unaligned_access, 0 .attribute stack_align, 16 - .global _start - _start: + .global main + main: addi sp,sp,-32 sd ra,16(sp) sd s0,8(sp) sd s1,0(sp) addi s0,sp,32 call init_part_apps - call main + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) ld ra,16(sp) ld s0,8(sp) ld s1,0(sp) @@ -1597,49 +866,35 @@ 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) + 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,-24(s0) + ld a3,-56(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 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 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) + addi sp,sp,-96 + sd ra,88(sp) + sd s0,80(sp) + addi s0,sp,96 + sd a0,-96(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-24(s0) + ld a3,-96(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) @@ -1647,48 +902,45 @@ li a1,1 call part_app mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 + 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) - ld a0,-152(s0) + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a0,-128(s0) + lui a0,%hi(a) + addi a0,a0,%lo(a) li a2,0 - li a1,0 + li a1,1 call part_app - sd a0,-24(s0) + sd a0,-32(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-24(s0) + ld a3,-32(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) + sd a0,-48(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 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 ret - main: - addi sp,sp,-80 - sd ra,72(sp) - sd s0,64(sp) - addi s0,sp,80 + main2: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 lui a0,%hi(foo) addi a0,a0,%lo(foo) li a5,9 @@ -1697,16 +949,12 @@ 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 + sd a0,-32(s0) li t0,0 mv a0,t0 - ld ra,72(sp) - ld s0,64(sp) - addi sp,sp,80 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 ret $ dune exec riscv64_instr_test < manytests/typed/007order.ml From 974e5bbe99bbe24800ca505e8a9b1f2c57229436 Mon Sep 17 00:00:00 2001 From: Ivan Date: Thu, 10 Apr 2025 19:23:38 +0300 Subject: [PATCH 28/45] Rewrite closure conversion --- slarnML/lib/anf/clos_conv.ml | 284 ++++------------ slarnML/lib/test/anf_test.ml | 6 +- slarnML/test/anf_conv_test.t | 268 ++++++++------- slarnML/test/clos_conv_test.t | 50 +-- slarnML/test/lambda_lifting_test.t | 60 ++-- slarnML/test/riscv64_instr_test.t | 530 +---------------------------- 6 files changed, 295 insertions(+), 903 deletions(-) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 4452de65c..61e89b8c5 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -2,230 +2,92 @@ (** SPDX-License-Identifier: LGPL-2.1-or-later *) -open Ast +(* 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 default_fun = List.map (fun (id, _) -> (id, id, 0, [])) Call_define.default_func +let remove_args args prt_args = + List.filter (fun x -> not (List.mem x args)) prt_args ;; -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) +let get_new_name id cnt = if id = "()" then id else id^"_"^(string_of_int cnt);; + +let rec closure_conversion ?(env=[]) ?(prt_args=[]) = function +| Ast.Id id -> (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> print_string ("Id "^id^" not found in env\n"); CId id + | Some (_, new_name, _, _) -> CId new_name) +| Ast.Const const -> CConst const +| Ast.Not e -> CNot (closure_conversion ~env ~prt_args e) +| Ast.Or (e1, e2) -> COr (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.And (e1, e2) -> CAnd (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Eq (e1, e2) -> CEq (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Gt (e1, e2) -> CGt (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Lt (e1, e2) -> CLt (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Gte (e1, e2) -> CGte (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Lte (e1, e2) -> CLte (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Add (e1, e2) -> CAdd (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Sub (e1, e2) -> CSub (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Mul (e1, e2) -> CMul (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.Div (e1, e2) -> CDiv (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) +| Ast.If (cond, then_expr, else_expr) -> + CIf (closure_conversion ~env ~prt_args cond, closure_conversion ~env ~prt_args then_expr, closure_conversion ~env ~prt_args else_expr) +| Ast.Let (decl, body) -> + let id, args, declared, next_name = (match decl with + | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args args prt_args)@args)), (fun old _ -> old) + | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args args prt_args)@args)), (fun _ new_name -> new_name)) 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 - 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 - |> 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 -> - 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 = - 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 - 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 - |> 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 -> - 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" - | 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 ] - | CLet (DeclRec (id, _), _) -> [ id ] - | CLetIn (DeclRec (id, _), _, _) -> [ id ] - | _ -> [] + let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in + (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> CLet (declared id args, closure_conversion ~env:((id, id, 0, (remove_args args prt_args)) :: env_args) ~prt_args:(args@prt_args) body) + | Some (_, old_name, cnt, _) -> + let new_name = get_new_name id cnt in + let body_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args args prt_args)) :: env_args) ~prt_args:(args @ prt_args) body in + CLet (declared new_name args, body_converted)) +| Ast.LetIn (decl, expr1, expr2) -> + let id, args, declared, next_name = (match decl with + | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args args prt_args)@args)), (fun old _ -> old) + | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args args prt_args)@args)), (fun _ new_name -> new_name)) + in + let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in + (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> + let decl_converted = closure_conversion ~env:((id, id, 0, (remove_args args prt_args)) :: env_args) ~prt_args:(args @ prt_args) expr1 in + let expr2_converted = closure_conversion ~env:((id, id, 0, (remove_args args prt_args)) :: env) ~prt_args expr2 in + CLetIn (declared id args, decl_converted, expr2_converted) + | Some (_, old_name, cnt, _) -> + let new_name = get_new_name id cnt in + let decl_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args args prt_args)) :: env) ~prt_args:(args @ prt_args) expr1 in + let expr2_converted = closure_conversion ~env:((id, new_name, cnt + 1, (remove_args args prt_args)) :: env) ~prt_args expr2 in + CLetIn (declared new_name args, decl_converted, expr2_converted)) +| Ast.Fun (args, body) -> + let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in + let body_converted = closure_conversion ~env:((List.hd args, List.hd args, 0, prt_args) :: env_args) ~prt_args:(args @ prt_args) body in + CFun ((prt_args@args), body_converted) +| Ast.App (func, args) -> + let func_converted = closure_conversion ~env func in + let args_converted = List.map (closure_conversion ~env) args in + let prt_args = List.map (fun arg -> CId arg) (match func with + | Ast.Id id -> (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> prt_args + | Some (_, _, _, args) -> args) + | _ -> prt_args) + in + CApp (func_converted, prt_args@args_converted) ;; -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)) + let ast = closure_conversion ~env:funs ast in + let new_funs = match ast with + | CLet (d, _) | CLetIn (d, _, _) -> + (match d with | Ast.Decl (id, _) | Ast.DeclRec (id, _) -> (id, id, 0, []) :: funs) + | _ -> funs + in + Result (cc_ast @ [ast], new_funs)) (Result ([], default_fun)) ast >>= fun (ast, _) -> Result ast diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml index 673d81976..ab6662f94 100644 --- a/slarnML/lib/test/anf_test.ml +++ b/slarnML/lib/test/anf_test.ml @@ -2,12 +2,12 @@ (** SPDX-License-Identifier: LGPL-2.1-or-later *) -open Res +(* open Res *) (*==============================*) (*======Closure conversion======*) (*==============================*) -open Ast +(* open Ast open Cc_ast open Clos_conv open Pprint_cc @@ -567,4 +567,4 @@ let anf6 = ] ;; -let%test _ = anf_ok "anf_6" ll6 anf6 +let%test _ = anf_ok "anf_6" ll6 anf6 *) diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index cbd5ad0ea..bd1fe14b4 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -4,7 +4,7 @@ > (fack n (fun x -> x)) > ;; > EOF - (fun anon$1(n f x)-> + (fun anon$1(x)-> (let anf_app#1=(f n) in (let anf_op#2=(x*anf_app#1) @@ -22,11 +22,9 @@ ) else ( (let anf_op#6=(n-1) in - (let anf_app#7=(anon$1 n f) + (let anf_app#7=(fack anf_op#6 anon$1) in - (let anf_app#8=(fack anf_op#6 anf_app#7) - in - anf_app#8)))) + anf_app#7))) in anf_if#4)) ) @@ -34,11 +32,9 @@ x ) (fun fac(n)-> - (let anf_app#9=(anon$2 ) - in - (let anf_app#10=(fack n anf_app#9) + (let anf_app#8=(fack n anon$2) in - anf_app#10)) + anf_app#8) ) $ dune exec anf_conv_test << EOF > let fac n = @@ -76,7 +72,7 @@ > in > (g 2 3) > EOF - (fun h(a c d e)-> + (fun h(c d a e)-> (let anf_app#1=(a ) in (let anf_app#2=(c ) @@ -94,7 +90,7 @@ anf_op#7))))))) ) (fun g(a c d)-> - (let anf_app#8=(h a c d 4) + (let anf_app#8=(h c d a 4) in anf_app#8) ) @@ -104,7 +100,32 @@ anf_app#9) ) $ dune exec anf_conv_test < manytests/do_not_type/001.ml - fac not exist + Id fac not found in env + (fun recfac(n)-> + (let anf_app#1=(n ) + in + (let anf_op#2=(anf_app#1<=1) + in + (let anf_if#3=if (anf_op#2) + then ( + 1 + ) else ( + (let anf_app#4=(n ) + in + (let anf_app#5=(n ) + in + (let anf_app#6=(n ) + in + (let anf_op#7=(anf_app#6-1) + in + (let anf_app#8=(fac anf_app#5 anf_op#7) + in + (let anf_op#9=(anf_app#4*anf_app#8) + in + anf_op#9))))))) + in + anf_if#3))) + ) $ dune exec anf_conv_test < manytests/do_not_type/002if.ml (fun main()-> (let anf_if#1=if (true) @@ -116,7 +137,30 @@ anf_if#1) ) $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml - f not exist + Id f not found in env + (fun anon$2(f)-> + (let anf_app#1=(x f x f) + in + anf_app#1) + ) + (fun anon$1(f x)-> + (let anf_app#2=(f anon$2) + in + anf_app#2) + ) + (fun fix(f)-> + anon$1 + ) + (fun anon$4(f)-> + (let anf_app#3=(x x f) + in + anf_app#3) + ) + (fun anon$3(x)-> + (let anf_app#4=(f x anon$4) + in + anf_app#4) + ) $ dune exec anf_conv_test < manytests/typed/001fac.ml (fun fac(n)-> (let anf_op#1=(n<=1) @@ -145,7 +189,7 @@ 0))) ) $ dune exec anf_conv_test < manytests/typed/002fac.ml - (fun anon$1(n k p)-> + (fun anon$1(p)-> (let anf_op#1=(p*n) in (let anf_app#2=(k anf_op#1) @@ -163,11 +207,9 @@ ) else ( (let anf_op#6=(n-1) in - (let anf_app#7=(anon$1 n k) + (let anf_app#7=(fac_cps anf_op#6 anon$1) in - (let anf_app#8=(fac_cps anf_op#6 anf_app#7) - in - anf_app#8)))) + anf_app#7))) in anf_if#4)) ) @@ -175,23 +217,21 @@ print_int ) (fun main()-> - (let anf_app#9=(anon$2 ) - in - (let anf_app#10=(fac_cps 4 anf_app#9) + (let anf_app#8=(fac_cps 4 anon$2) in - (let anf_app#11=(print_int anf_app#10) + (let anf_app#9=(print_int anf_app#8) in - (let anf_()#12=anf_app#11 + (let anf_()#10=anf_app#9 in - 0)))) + 0))) ) $ dune exec anf_conv_test < manytests/typed/003fib.ml - (fun n1(n)-> + (fun n1(a b n)-> (let anf_op#1=(n-1) in anf_op#1) ) - (fun ab(a b)-> + (fun ab(a b n)-> (let anf_op#2=(a+b) in anf_op#2) @@ -261,83 +301,85 @@ in anf_if#2)) ) - (fun a(a)-> - (let anf_app#5=(print_int a) + (fun a_0(a b c)-> + (let anf_app#5=(a ) in - anf_app#5) - ) - (fun b(b)-> - (let anf_app#6=(print_int b) + (let anf_app#6=(print_int anf_app#5) in - anf_app#6) + anf_app#6)) ) - (fun c(c)-> - (let anf_app#7=(print_int c) + (fun b_0(a b c)-> + (let anf_app#7=(print_int b) in anf_app#7) ) + (fun c_0(a b c)-> + (let anf_app#8=(print_int c) + in + anf_app#8) + ) (fun test3(a b c)-> 0 ) (fun test10(a b c d e f g h i j)-> - (let anf_app#8=(a ) + (let anf_app#9=(a ) in - (let anf_app#9=(b ) + (let anf_app#10=(b ) in - (let anf_op#10=(anf_app#8+anf_app#9) + (let anf_op#11=(anf_app#9+anf_app#10) in - (let anf_app#11=(c ) + (let anf_app#12=(c ) in - (let anf_op#12=(anf_op#10+anf_app#11) + (let anf_op#13=(anf_op#11+anf_app#12) in - (let anf_app#13=(d ) + (let anf_app#14=(d ) in - (let anf_op#14=(anf_op#12+anf_app#13) + (let anf_op#15=(anf_op#13+anf_app#14) in - (let anf_app#15=(e ) + (let anf_app#16=(e ) in - (let anf_op#16=(anf_op#14+anf_app#15) + (let anf_op#17=(anf_op#15+anf_app#16) in - (let anf_app#17=(f ) + (let anf_app#18=(f ) in - (let anf_op#18=(anf_op#16+anf_app#17) + (let anf_op#19=(anf_op#17+anf_app#18) in - (let anf_app#19=(g ) + (let anf_app#20=(g ) in - (let anf_op#20=(anf_op#18+anf_app#19) + (let anf_op#21=(anf_op#19+anf_app#20) in - (let anf_app#21=(h ) + (let anf_app#22=(h ) in - (let anf_op#22=(anf_op#20+anf_app#21) + (let anf_op#23=(anf_op#21+anf_app#22) in - (let anf_app#23=(i ) + (let anf_app#24=(i ) in - (let anf_op#24=(anf_op#22+anf_app#23) + (let anf_op#25=(anf_op#23+anf_app#24) in - (let anf_app#25=(j ) + (let anf_app#26=(j ) in - (let anf_op#26=(anf_op#24+anf_app#25) + (let anf_op#27=(anf_op#25+anf_app#26) in - anf_op#26))))))))))))))))))) + anf_op#27))))))))))))))))))) ) (fun rez()-> - (let anf_app#27=(test10 ) + (let anf_app#28=(test10 ) in - (let anf_app#28=(wrap anf_app#27 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#29=(wrap anf_app#28 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - anf_app#28)) + anf_app#29)) ) (fun temp2()-> - (let anf_app#29=(test3 ) + (let anf_app#30=(test3 ) in - (let anf_app#30=(wrap anf_app#29 1 10 100) + (let anf_app#31=(wrap anf_app#30 1 10 100) in - anf_app#30)) + anf_app#31)) ) (fun main()-> - (let anf_app#31=(print_int rez) + (let anf_app#32=(print_int rez) in - (let anf_()#32=anf_app#31 + (let anf_()#33=anf_app#32 in 0)) ) @@ -384,12 +426,12 @@ 0)))) ) $ dune exec anf_conv_test < manytests/typed/006partial.ml - (fun anon$1(foo)-> + (fun anon$1(b foo)-> (let anf_op#1=(foo+2) in anf_op#1) ) - (fun anon$2(foo)-> + (fun anon$2(b foo)-> (let anf_op#2=(foo*10) in anf_op#2) @@ -399,35 +441,31 @@ in (let anf_if#4=if (anf_app#3) then ( - (let anf_app#5=(anon$1 ) - in - anf_app#5) + anon$1 ) else ( - (let anf_app#6=(anon$2 ) - in - anf_app#6)) + anon$2) in anf_if#4)) ) - (fun foo(x)-> - (let anf_app#7=(x ) + (fun foo_0(x)-> + (let anf_app#5=(x ) in - (let anf_app#8=(foo false anf_app#7) + (let anf_app#6=(foo false anf_app#5) in - (let anf_app#9=(foo true anf_app#8) + (let anf_app#7=(foo true anf_app#6) in - (let anf_app#10=(foo false anf_app#9) + (let anf_app#8=(foo false anf_app#7) in - (let anf_app#11=(foo true anf_app#10) + (let anf_app#9=(foo true anf_app#8) in - anf_app#11))))) + anf_app#9))))) ) (fun main()-> - (let anf_app#12=(foo 11) + (let anf_app#10=(foo 11) in - (let anf_app#13=(print_int anf_app#12) + (let anf_app#11=(print_int anf_app#10) in - (let anf_()#14=anf_app#13 + (let anf_()#12=anf_app#11 in 0))) ) @@ -439,82 +477,68 @@ 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) + (let anf_app#4=(print_int b) in - (let anf_()#9=anf_app#8 + (let anf_()#5=anf_app#4 in - (let anf_app#10=(a ) + (let anf_app#6=(print_int c) in - (let anf_app#11=(b ) - in - (let anf_app#12=(c ) + (let anf_()#7=anf_app#6 in - (let anf_op#13=(anf_app#11*anf_app#12) + (let anf_op#8=(b*c) in - (let anf_op#14=(anf_app#10+anf_op#13) + (let anf_op#9=(a+anf_op#8) in - anf_op#14)))))))))))))) + anf_op#9))))))))) ) - (fun foo()-> - (let anf_app#15=(foo 1) + (fun foo_0()-> + (let anf_app#10=(foo 1) in - anf_app#15) + anf_app#10) ) - (fun foo(foo)-> - (let anf_app#16=(foo_1 foo_1 2) + (fun foo_1()-> + (let anf_app#11=(foo_0 2) in - anf_app#16) + anf_app#11) ) - (fun foo(foo)-> - (let anf_app#17=(foo_1 foo_1 3) + (fun foo_2()-> + (let anf_app#12=(foo_1 3) in - anf_app#17) + anf_app#12) ) (fun main()-> - (let anf_app#18=(print_int foo) + (let anf_app#13=(print_int foo_2) in - (let anf_()#19=anf_app#18 + (let anf_()#14=anf_app#13 in 0)) ) $ dune exec anf_conv_test < manytests/typed/006partial3.ml - (fun anon$2(c)-> + (fun anon$2(b a c)-> (let anf_app#1=(print_int c) in anf_app#1) ) - (fun anon$1(b)-> + (fun anon$1(a b)-> (let anf_app#2=(print_int b) in (let anf_()#3=anf_app#2 in - (let anf_app#4=(anon$2 ) - in - anf_app#4))) + anon$2)) ) (fun foo(a)-> - (let anf_app#5=(a ) + (let anf_app#4=(a ) in - (let anf_app#6=(print_int anf_app#5) - in - (let anf_()#7=anf_app#6 + (let anf_app#5=(print_int anf_app#4) in - (let anf_app#8=(anon$1 ) + (let anf_()#6=anf_app#5 in - anf_app#8)))) + anon$1))) ) (fun main()-> - (let anf_app#9=(foo 4 8 9) + (let anf_app#7=(foo 4 8 9) in - (let anf_()#10=anf_app#9 + (let anf_()#8=anf_app#7 in 0)) ) diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index 46857d584..aff6247a2 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -4,23 +4,23 @@ > (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) )))) + (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 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))) + (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 + > let h e d = 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))) + (let f a=(let g a c d=(let h c a e d=(a*(c+(d*e))) in (h c a 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) > @@ -28,37 +28,37 @@ > 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)) + (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)) + (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)) + (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 clos_conv_test < manytests/typed/003fib.ml - (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))) + (let rec fib_acc a b n=if ((n=1)) then (b) else ((let n1 a b n=(n-1) in (let ab a b n=(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 test3 a b c=(let a_0 a b c=(print_int a) in (let b_0 a b c=(print_int b) in (let c_0 a b 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 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)))) + (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))))) - (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 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)) + (let foo b=if (b) then ((fun b foo->(foo+2))) else ((fun b foo->(foo*10)))) + (let foo_0 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))))) + (let foo a b c=(let () a b c=(print_int a) in (let () a b c=(print_int b) in (let () a b c=(print_int c) in (a+(b*c)))))) + (let main=(let foo_0=(foo 1) in (let foo_1=(foo_0 2) in (let foo_2=(foo_1 3) in (let ()=(print_int foo_2) 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)) + (let foo a=(let () a=(print_int a) in (fun a b->(let () b a=(print_int b) in (fun b a 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 diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index b81fce325..c4e4b9162 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -4,10 +4,10 @@ > (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$1(x)->((x*(f n)))) + (fun fack(n f)->(if ((n<=1)) then ((f 1)) else ((fack (n-1) anon$1)))) (fun anon$2(x)->(x)) - (fun fac(n)->((fack n (anon$2 )))) + (fun fac(n)->((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 @@ -24,34 +24,40 @@ > in > (g 2 3) > EOF - (fun h(a c d e)->(((a )*((c )+((d )*(e )))))) - (fun g(a c d)->((h a c d 4))) + (fun h(c d a e)->(((a )*((c )+((d )*(e )))))) + (fun g(a c d)->((h c d a 4))) (fun f(a)->((g a 2 3))) $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml - fac not exist + Id fac not found in env + (fun recfac(n)->(if (((n )<=1)) then (1) else (((n )*(fac (n ) ((n )-1)))))) $ 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 + Id f not found in env + (fun anon$2(f)->((x f x f))) + (fun anon$1(f x)->((f anon$2))) + (fun fix(f)->(anon$1)) + (fun anon$4(f)->((x x f))) + (fun anon$3(x)->((f x anon$4))) $ 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(p)->((k (p*n)))) + (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) anon$1)))) (fun anon$2(print_int)->(print_int)) - (fun main()->(let () = ((print_int (fac_cps 4 (anon$2 ))) in 0))) + (fun main()->(let () = ((print_int (fac_cps 4 anon$2)) in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml - (fun n1(n)->((n-1))) - (fun ab(a b)->((a+b))) + (fun n1(a b n)->((n-1))) + (fun ab(a b n)->((a+b))) (fun fib_acc(a b n)->(if ((n=1)) then (b) else ((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))) - (fun b(b)->((print_int b))) - (fun c(c)->((print_int c))) + (fun a_0(a b c)->((print_int (a )))) + (fun b_0(a b c)->((print_int b))) + (fun c_0(a b c)->((print_int c))) (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 rez()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) @@ -62,21 +68,21 @@ (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 anon$1(b foo)->((foo+2))) + (fun anon$2(b foo)->((foo*10))) + (fun foo(b)->(if ((b )) then (anon$1) else (anon$2))) + (fun foo_0(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_1 foo_1 2))) - (fun foo(foo)->((foo_1 foo_1 3))) - (fun main()->(let () = ((print_int foo) 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_0()->((foo 1))) + (fun foo_1()->((foo_0 2))) + (fun foo_2()->((foo_1 3))) + (fun main()->(let () = ((print_int foo_2) 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 anon$2(b a c)->((print_int c))) + (fun anon$1(a 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 5c7c9ef57..af1372fe0 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -4,125 +4,7 @@ > (fack n (fun x -> x)) > ;; > EOF - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global main - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main2 - sd a0,24(sp) - call cleanup_part_apps - ld a0,24(sp) - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - 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) - 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: - 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 - lui a0,%hi(f) - addi a0,a0,%lo(f) - li a3,1 - li a2,1 - li a1,2 - 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,-32(s0) - sd t1,-40(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - ld a4,-152(s0) - ld a3,-144(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-48(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a4,-48(s0) - ld a3,-40(s0) - li a2,2 - li a1,2 - call part_app - .tag_anf_op_3_t: - sd a0,-56(s0) - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - anon_2: - 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) - addi a0,a0,%lo(anon_2) - li a2,0 - li a1,1 - call part_app - sd a0,-32(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a4,-32(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 @@ -232,17 +114,17 @@ sd a2,-192(s0) sd a1,-184(s0) sd a0,-176(s0) - ld a0,-176(s0) + ld a0,-192(s0) li a2,0 li a1,0 call part_app sd a0,-32(s0) - ld a0,-184(s0) + ld a0,-176(s0) li a2,0 li a1,0 call part_app sd a0,-40(s0) - ld a0,-192(s0) + ld a0,-184(s0) li a2,0 li a1,0 call part_app @@ -273,9 +155,9 @@ lui a0,%hi(h) addi a0,a0,%lo(h) li a6,4 - ld a5,-72(s0) - ld a4,-64(s0) - ld a3,-56(s0) + ld a5,-56(s0) + ld a4,-72(s0) + ld a3,-64(s0) li a2,4 li a1,4 call part_app @@ -304,7 +186,8 @@ addi sp,sp,64 ret $ dune exec riscv64_instr_test < manytests/do_not_type/001.ml - fac not exist + Id fac not found in env + fac not found $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml .attribute unaligned_access, 0 @@ -348,7 +231,8 @@ ret $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml - f not exist + Id f not found in env + x not found $ dune exec riscv64_instr_test < manytests/typed/001fac.ml .attribute unaligned_access, 0 @@ -430,132 +314,7 @@ ret $ dune exec riscv64_instr_test < manytests/typed/002fac.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global main - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main2 - sd a0,24(sp) - call cleanup_part_apps - ld a0,24(sp) - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - 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,-32(s0) - ld a0,-72(s0) - ld a3,-32(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,-32(s0) - sd t1,-40(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - ld a4,-152(s0) - ld a3,-144(s0) - li a2,2 - li a1,3 - call part_app - sd a0,-48(s0) - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - ld a4,-48(s0) - ld a3,-40(s0) - li a2,2 - li a1,2 - call part_app - .tag_anf_op_3_t: - sd a0,-56(s0) - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - anon_2: - 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 - main2: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - li a2,0 - li a1,1 - call part_app - sd a0,-32(s0) - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - ld a4,-32(s0) - li a3,4 - li a2,2 - li a1,2 - call part_app - sd a0,-40(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-40(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-48(s0) - li t0,0 - mv a0,t0 - ld ra,112(sp) - ld s0,104(sp) - addi sp,sp,128 - ret + n not found $ dune exec riscv64_instr_test < manytests/typed/003fib.ml ab not found @@ -690,272 +449,13 @@ ret $ dune exec riscv64_instr_test < manytests/typed/006partial.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global main - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main2 - sd a0,24(sp) - call cleanup_part_apps - ld a0,24(sp) - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - 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,-32(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,-40(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,-48(s0) - mv a0,a0 - ld ra,120(sp) - ld s0,112(sp) - addi sp,sp,128 - ret - foo_1: - 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,-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 - sd a0,-48(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-48(s0) - li a3,0 - li a2,2 - li a1,1 - call part_app - sd a0,-56(s0) - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - ld a4,-56(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 - main2: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - lui a0,%hi(foo) - addi a0,a0,%lo(foo) - li a3,11 - li a2,1 - li a1,1 - 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) - li t0,0 - mv a0,t0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret + anon$1 not found $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml - foo_1 not found + foo_2 not found $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global main - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main2 - sd a0,24(sp) - call cleanup_part_apps - ld a0,24(sp) - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - li a7,93 - ecall - anon_2: - 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: - addi sp,sp,-96 - sd ra,88(sp) - sd s0,80(sp) - addi s0,sp,96 - sd a0,-96(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-96(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - 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,88(sp) - ld s0,80(sp) - addi sp,sp,96 - ret - foo: - addi sp,sp,-128 - sd ra,120(sp) - sd s0,112(sp) - addi s0,sp,128 - sd a0,-128(s0) - lui a0,%hi(a) - addi a0,a0,%lo(a) - li a2,0 - li a1,1 - 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) - sd a0,-48(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,120(sp) - ld s0,112(sp) - addi sp,sp,128 - ret - main2: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 - 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,-32(s0) - li t0,0 - mv a0,t0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 - ret + anon$2 not found $ dune exec riscv64_instr_test < manytests/typed/007order.ml : end_of_input From 310a4fa64d2fcde5ae9ff48e956c4c2e9109e8e2 Mon Sep 17 00:00:00 2001 From: Ivan Date: Thu, 10 Apr 2025 19:40:09 +0300 Subject: [PATCH 29/45] Fix closure conversion for () and in global env --- slarnML/lib/anf/clos_conv.ml | 39 +++++++++++++------------ slarnML/test/anf_conv_test.t | 46 ++++++++++++++++++------------ slarnML/test/clos_conv_test.t | 8 +++--- slarnML/test/lambda_lifting_test.t | 10 +++---- slarnML/test/riscv64_instr_test.t | 2 +- 5 files changed, 59 insertions(+), 46 deletions(-) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 61e89b8c5..2ff5b90eb 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -7,8 +7,7 @@ open Cc_ast open Res let default_fun = List.map (fun (id, _) -> (id, id, 0, [])) Call_define.default_func -let remove_args args prt_args = - List.filter (fun x -> not (List.mem x args)) prt_args +let remove_args id args prt_args = if id = "()" then [] else List.filter (fun x -> not (List.mem x args)) prt_args ;; let get_new_name id cnt = if id = "()" then id else id^"_"^(string_of_int cnt);; @@ -34,31 +33,31 @@ let rec closure_conversion ?(env=[]) ?(prt_args=[]) = function CIf (closure_conversion ~env ~prt_args cond, closure_conversion ~env ~prt_args then_expr, closure_conversion ~env ~prt_args else_expr) | Ast.Let (decl, body) -> let id, args, declared, next_name = (match decl with - | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args args prt_args)@args)), (fun old _ -> old) - | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args args prt_args)@args)), (fun _ new_name -> new_name)) + | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun old _ -> old) + | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun _ new_name -> new_name)) in let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in (match List.find_opt (fun (name, _, _, _) -> name = id) env with - | None -> CLet (declared id args, closure_conversion ~env:((id, id, 0, (remove_args args prt_args)) :: env_args) ~prt_args:(args@prt_args) body) + | None -> CLet (declared id args, closure_conversion ~env:((id, id, 0, (remove_args id args prt_args)) :: env_args) ~prt_args:(args@prt_args) body) | Some (_, old_name, cnt, _) -> - let new_name = get_new_name id cnt in - let body_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args args prt_args)) :: env_args) ~prt_args:(args @ prt_args) body in + let new_name = get_new_name old_name cnt in + let body_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args id args prt_args)) :: env_args) ~prt_args:(args @ prt_args) body in CLet (declared new_name args, body_converted)) | Ast.LetIn (decl, expr1, expr2) -> let id, args, declared, next_name = (match decl with - | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args args prt_args)@args)), (fun old _ -> old) - | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args args prt_args)@args)), (fun _ new_name -> new_name)) + | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun old _ -> old) + | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun _ new_name -> new_name)) in let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in (match List.find_opt (fun (name, _, _, _) -> name = id) env with | None -> - let decl_converted = closure_conversion ~env:((id, id, 0, (remove_args args prt_args)) :: env_args) ~prt_args:(args @ prt_args) expr1 in - let expr2_converted = closure_conversion ~env:((id, id, 0, (remove_args args prt_args)) :: env) ~prt_args expr2 in + let decl_converted = closure_conversion ~env:((id, id, 0, (remove_args id args prt_args)) :: env_args) ~prt_args:(args @ prt_args) expr1 in + let expr2_converted = closure_conversion ~env:((id, id, 0, (remove_args id args prt_args)) :: env) ~prt_args expr2 in CLetIn (declared id args, decl_converted, expr2_converted) | Some (_, old_name, cnt, _) -> - let new_name = get_new_name id cnt in - let decl_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args args prt_args)) :: env) ~prt_args:(args @ prt_args) expr1 in - let expr2_converted = closure_conversion ~env:((id, new_name, cnt + 1, (remove_args args prt_args)) :: env) ~prt_args expr2 in + let new_name = get_new_name old_name cnt in + let decl_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args id args prt_args)) :: env) ~prt_args:(args @ prt_args) expr1 in + let expr2_converted = closure_conversion ~env:((id, new_name, cnt + 1, (remove_args id args prt_args)) :: env) ~prt_args expr2 in CLetIn (declared new_name args, decl_converted, expr2_converted)) | Ast.Fun (args, body) -> let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in @@ -81,13 +80,17 @@ let clos_conv ast = (fun cc_ast ast -> cc_ast >>= fun (cc_ast, funs) -> - let ast = closure_conversion ~env:funs ast in - let new_funs = match ast with + let c_ast = closure_conversion ~env:funs ast in + let new_funs = match c_ast with | CLet (d, _) | CLetIn (d, _, _) -> - (match d with | Ast.Decl (id, _) | Ast.DeclRec (id, _) -> (id, id, 0, []) :: funs) + (match d with | Ast.Decl (new_name, _) | Ast.DeclRec (new_name, _) -> + (match ast with + | Ast.Let (d, _) | Ast.LetIn (d, _, _) -> + (match d with | Ast.Decl (old_name, _) | Ast.DeclRec (old_name, _) -> (old_name, new_name, 0, []) :: funs) + | _ -> (new_name, new_name, 0, []) :: funs)) | _ -> funs in - Result (cc_ast @ [ast], new_funs)) + Result (cc_ast @ [c_ast], new_funs)) (Result ([], default_fun)) ast >>= fun (ast, _) -> Result ast diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index bd1fe14b4..cfcaf972c 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -461,7 +461,7 @@ anf_app#9))))) ) (fun main()-> - (let anf_app#10=(foo 11) + (let anf_app#10=(foo_0 11) in (let anf_app#11=(print_int anf_app#10) in @@ -477,39 +477,49 @@ in (let anf_()#3=anf_app#2 in - (let anf_app#4=(print_int b) + (let anf_app#4=(b ) in - (let anf_()#5=anf_app#4 + (let anf_app#5=(print_int anf_app#4) + in + (let anf_()#6=anf_app#5 in - (let anf_app#6=(print_int c) + (let anf_app#7=(c ) in - (let anf_()#7=anf_app#6 + (let anf_app#8=(print_int anf_app#7) in - (let anf_op#8=(b*c) + (let anf_()#9=anf_app#8 in - (let anf_op#9=(a+anf_op#8) + (let anf_app#10=(a ) in - anf_op#9))))))))) + (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_0()-> - (let anf_app#10=(foo 1) + (let anf_app#15=(foo 1) in - anf_app#10) + anf_app#15) ) - (fun foo_1()-> - (let anf_app#11=(foo_0 2) + (fun foo_0_1()-> + (let anf_app#16=(foo_0 2) in - anf_app#11) + anf_app#16) ) - (fun foo_2()-> - (let anf_app#12=(foo_1 3) + (fun foo_0_1_2()-> + (let anf_app#17=(foo_0_1 3) in - anf_app#12) + anf_app#17) ) (fun main()-> - (let anf_app#13=(print_int foo_2) + (let anf_app#18=(print_int foo_0_1_2) in - (let anf_()#14=anf_app#13 + (let anf_()#19=anf_app#18 in 0)) ) diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index aff6247a2..80f503a46 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -52,12 +52,12 @@ $ dune exec clos_conv_test < manytests/typed/006partial.ml (let foo b=if (b) then ((fun b foo->(foo+2))) else ((fun b foo->(foo*10)))) (let foo_0 x=(foo true (foo false (foo true (foo false x))))) - (let main=(let ()=(print_int (foo 11)) in 0)) + (let main=(let ()=(print_int (foo_0 11)) in 0)) $ dune exec clos_conv_test < manytests/typed/006partial2.ml - (let foo a b c=(let () a b c=(print_int a) in (let () a b c=(print_int b) in (let () a b c=(print_int c) in (a+(b*c)))))) - (let main=(let foo_0=(foo 1) in (let foo_1=(foo_0 2) in (let foo_2=(foo_1 3) in (let ()=(print_int foo_2) 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_0=(foo 1) in (let foo_0_1=(foo_0 2) in (let foo_0_1_2=(foo_0_1 3) in (let ()=(print_int foo_0_1_2) in 0))))) $ dune exec clos_conv_test < manytests/typed/006partial3.ml - (let foo a=(let () a=(print_int a) in (fun a b->(let () b a=(print_int b) in (fun b a c->(print_int c)))))) + (let foo a=(let ()=(print_int a) in (fun a b->(let ()=(print_int b) in (fun b a 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 c4e4b9162..6c6b6e196 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -72,13 +72,13 @@ (fun anon$2(b foo)->((foo*10))) (fun foo(b)->(if ((b )) then (anon$1) else (anon$2))) (fun foo_0(x)->((foo true (foo false (foo true (foo false (x ))))))) - (fun main()->(let () = ((print_int (foo 11)) in 0))) + (fun main()->(let () = ((print_int (foo_0 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(a b c)->(let () = ((print_int (a )) in let () = ((print_int (b )) in let () = ((print_int (c )) in ((a )+((b )*(c )))))))) (fun foo_0()->((foo 1))) - (fun foo_1()->((foo_0 2))) - (fun foo_2()->((foo_1 3))) - (fun main()->(let () = ((print_int foo_2) in 0))) + (fun foo_0_1()->((foo_0 2))) + (fun foo_0_1_2()->((foo_0_1 3))) + (fun main()->(let () = ((print_int foo_0_1_2) in 0))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml (fun anon$2(b a c)->((print_int c))) (fun anon$1(a b)->(let () = ((print_int b) in anon$2))) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index af1372fe0..9898c0fa9 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -452,7 +452,7 @@ anon$1 not found $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml - foo_2 not found + foo_0_1_2 not found $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml anon$2 not found From edcda0a582a443c332be526b26828177d8db3449 Mon Sep 17 00:00:00 2001 From: Ivan Date: Sun, 13 Apr 2025 19:19:48 +0300 Subject: [PATCH 30/45] Rewrite cc and eq in riscv --- slarnML/lib/anf/clos_conv.ml | 32 +- slarnML/lib/anf/lambda_lifting.ml | 58 +- slarnML/lib/pretty_print/pprint_ll.ml | 2 +- slarnML/lib/riscv64/part_app.c | 59 +- slarnML/lib/riscv64/print.S | 2 +- slarnML/lib/riscv64/riscv.ml | 12 +- slarnML/test/anf_conv_test.t | 378 ++++--- slarnML/test/clos_conv_test.t | 22 +- slarnML/test/exec_test.t_ | Bin 4375 -> 4330 bytes slarnML/test/lambda_lifting_test.t | 94 +- slarnML/test/parser_tests.t | 6 +- slarnML/test/part_app.c | 1 + slarnML/test/print.S | 1 + slarnML/test/riscv64_instr_test.t | 1344 ++++++++++++++++++++++--- 14 files changed, 1498 insertions(+), 513 deletions(-) create mode 120000 slarnML/test/part_app.c create mode 120000 slarnML/test/print.S diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 2ff5b90eb..41f373ef2 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -15,7 +15,7 @@ let get_new_name id cnt = if id = "()" then id else id^"_"^(string_of_int cnt);; let rec closure_conversion ?(env=[]) ?(prt_args=[]) = function | Ast.Id id -> (match List.find_opt (fun (name, _, _, _) -> name = id) env with | None -> print_string ("Id "^id^" not found in env\n"); CId id - | Some (_, new_name, _, _) -> CId new_name) + | Some (_, new_name, _, args) -> if List.length args > 0 then CApp (CId new_name, List.map (fun arg -> CId arg) args) else CId new_name) | Ast.Const const -> CConst const | Ast.Not e -> CNot (closure_conversion ~env ~prt_args e) | Ast.Or (e1, e2) -> COr (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) @@ -32,40 +32,40 @@ let rec closure_conversion ?(env=[]) ?(prt_args=[]) = function | Ast.If (cond, then_expr, else_expr) -> CIf (closure_conversion ~env ~prt_args cond, closure_conversion ~env ~prt_args then_expr, closure_conversion ~env ~prt_args else_expr) | Ast.Let (decl, body) -> - let id, args, declared, next_name = (match decl with - | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun old _ -> old) - | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun _ new_name -> new_name)) + let id, args, declared, pre_env = (match decl with + | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun _ _ -> []) + | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun new_name cnt -> [(id, new_name, cnt+1, (remove_args id args prt_args))])) in let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in (match List.find_opt (fun (name, _, _, _) -> name = id) env with - | None -> CLet (declared id args, closure_conversion ~env:((id, id, 0, (remove_args id args prt_args)) :: env_args) ~prt_args:(args@prt_args) body) + | None -> CLet (declared id args, closure_conversion ~env:((pre_env id 0) @env_args) ~prt_args:(args@prt_args) body) | Some (_, old_name, cnt, _) -> let new_name = get_new_name old_name cnt in - let body_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args id args prt_args)) :: env_args) ~prt_args:(args @ prt_args) body in + let body_converted = closure_conversion ~env:((pre_env new_name cnt) @env_args) ~prt_args:(args@prt_args) body in CLet (declared new_name args, body_converted)) | Ast.LetIn (decl, expr1, expr2) -> - let id, args, declared, next_name = (match decl with - | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun old _ -> old) - | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun _ new_name -> new_name)) + let id, args, declared, pre_env = (match decl with + | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun _ _ -> []) + | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun new_name cnt -> [(id, new_name, cnt + 1, (remove_args id args prt_args))])) in let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in (match List.find_opt (fun (name, _, _, _) -> name = id) env with | None -> - let decl_converted = closure_conversion ~env:((id, id, 0, (remove_args id args prt_args)) :: env_args) ~prt_args:(args @ prt_args) expr1 in + let decl_converted = closure_conversion ~env:((pre_env id 0) @env_args) ~prt_args:(args@prt_args) expr1 in let expr2_converted = closure_conversion ~env:((id, id, 0, (remove_args id args prt_args)) :: env) ~prt_args expr2 in CLetIn (declared id args, decl_converted, expr2_converted) | Some (_, old_name, cnt, _) -> let new_name = get_new_name old_name cnt in - let decl_converted = closure_conversion ~env:((id, next_name old_name new_name, cnt + 1, (remove_args id args prt_args)) :: env) ~prt_args:(args @ prt_args) expr1 in - let expr2_converted = closure_conversion ~env:((id, new_name, cnt + 1, (remove_args id args prt_args)) :: env) ~prt_args expr2 in + let decl_converted = closure_conversion ~env:((pre_env new_name cnt) @env_args) ~prt_args:(args@prt_args) expr1 in + let expr2_converted = closure_conversion ~env:((id, new_name, cnt + 2, (remove_args id args prt_args)) :: env) ~prt_args expr2 in CLetIn (declared new_name args, decl_converted, expr2_converted)) | Ast.Fun (args, body) -> let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in - let body_converted = closure_conversion ~env:((List.hd args, List.hd args, 0, prt_args) :: env_args) ~prt_args:(args @ prt_args) body in - CFun ((prt_args@args), body_converted) + let body_converted = closure_conversion ~env:env_args ~prt_args:(args @ prt_args) body in + CApp (CFun (((remove_args "" args prt_args)@args), body_converted), List.map (fun arg -> CId arg) prt_args) | Ast.App (func, args) -> - let func_converted = closure_conversion ~env func in - let args_converted = List.map (closure_conversion ~env) args in + let func_converted = closure_conversion ~env ~prt_args func in + let args_converted = List.map (closure_conversion ~env ~prt_args) args in let prt_args = List.map (fun arg -> CId arg) (match func with | Ast.Id id -> (match List.find_opt (fun (name, _, _, _) -> name = id) env with | None -> prt_args diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 0ad3579e4..4d8e60c6d 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -16,27 +16,12 @@ let get_name id _ = if String.contains id '#' then String.sub id 0 (String.index id '#') else id ;; -let replace_fun _ id env = - let base_id = - if String.contains id '#' then String.sub id 0 (String.index id '#') else id - in - let rec find_unique base counter = - let candidate = if counter = 0 then base else base ^ "_" ^ string_of_int counter in - if List.exists (fun (_, name, _) -> name = candidate) env - then find_unique base (counter + 1) - else candidate - in - find_unique base_id 0 -;; - -let find_name id = +let find_name fun_ids id = map (fun (_, _, env, _) -> - let base_id = - if String.contains id '#' then String.sub id 0 (String.index id '#') else id - in - match List.find_opt (fun (_, name, _) -> name = id || name = base_id) env with - | None -> Result (LApp (id, [])) - | Some (_, _, new_name) -> Result (LId new_name)) + (* print_endline ("find_name " ^ id ^ " " ^ String.concat ", " fun_ids); *) + match List.find_opt (fun (_, name, _) -> name = id) env with + | None -> if List.mem id fun_ids then Result (LApp (id, [])) else Result (LId id) + | Some (_, _, new_name) -> if List.mem id fun_ids then Result (LApp (new_name, [])) else Result (LId new_name)) ;; let insert_let a = map (fun (ast, lst, env, num) -> Result (ast, a :: lst, env, num)) @@ -47,7 +32,7 @@ let update_env name new_name lvl = let update_env_fun name stack lvl = map (fun (ast, prog, env, num) -> - let new_name = replace_fun name (get_name name stack) env in + let new_name = get_name name stack in Result (ast, prog, (lvl, name, new_name) :: env, num)) ;; @@ -66,14 +51,14 @@ let filter lvl = Result (ast, prog, List.filter (fun (l, _, _) -> l < lvl) env, num)) ;; -let rec lifting cc_ast stack lvl res = +let rec lifting cc_ast fun_ids stack lvl res = let lifting_bin_op f e1 e2 = res - |> lifting e1 stack lvl + |> lifting e1 fun_ids stack lvl |> fun r1 -> r1 |> get_ast - >>= fun a1 -> r1 |> lifting e2 stack lvl |> update_ast (fun a2 -> Result (f a1 a2)) + >>= fun a1 -> r1 |> lifting e2 fun_ids stack lvl |> update_ast (fun a2 -> Result (f a1 a2)) in let get_id = function | Ast.Decl (id, _) | Ast.DeclRec (id, _) -> id @@ -96,12 +81,12 @@ let rec lifting cc_ast stack lvl res = | 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 + res |> f1 |> update_env_fun id stack lvl |> lifting e1 (id :: fun_ids) (id :: stack) (lvl + 1) |> f2 in match cc_ast with - | CId id -> res |> find_name id >>= fun ast -> update_ast (fun _ -> Result ast) res + | CId id -> res |> find_name fun_ids 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 + | CNot e -> res |> lifting e fun_ids 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 @@ -115,18 +100,18 @@ let rec lifting cc_ast stack lvl res = | CDiv (e1, e2) -> lifting_bin_op (fun a1 a2 -> LDiv (a1, a2)) e1 e2 | CIf (e1, e2, e3) -> res - |> lifting e1 stack lvl + |> lifting e1 fun_ids stack lvl |> fun r1 -> r1 |> get_ast >>= fun a1 -> r1 - |> lifting e2 stack lvl + |> lifting e2 fun_ids stack lvl |> fun r2 -> r2 |> get_ast >>= fun a2 -> - r2 |> lifting e3 stack lvl |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) + r2 |> lifting e3 fun_ids stack lvl |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) | CLet (d, e) -> (* let id = get_id d in *) res @@ -142,7 +127,7 @@ let rec lifting cc_ast stack lvl res = |> get_ast >>= fun a1 -> (if id = "()" then r1 else r1 |> insert_let (get_fun_let (get_decl d) a1)) - |> lifting e2 stack lvl + |> lifting e2 (id::fun_ids) stack lvl |> update_ast (fun a2 -> Result (if id = "()" then LIn (id, a1, a2) else a2)) |> filter lvl | CFun (args, e) -> @@ -155,26 +140,26 @@ let rec lifting cc_ast stack lvl res = >>= fun name -> let new_name = get_name name stack in res - |> lifting e (name :: stack) (lvl + 1) + |> lifting e fun_ids (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)) + |> update_ast (fun _ -> Result (LApp (new_name, []))) | CApp (e, args) -> List.fold_left (fun r e -> r >>= fun (r, lst) -> Result r - |> lifting e stack lvl + |> lifting e fun_ids 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 + |> lifting e fun_ids stack lvl |> update_ast (fun a -> match a with | LApp (a, new_args) -> Result (LApp (a, List.append new_args args)) @@ -189,7 +174,8 @@ let lambda_lifting cc_ast = (fun prev_res ast -> prev_res >>= fun (anon_num, ll_ast) -> - lifting ast [] 0 (default_res anon_num) + let funs = List.map (fun e -> match e with | LFun (id, _, _) -> id) ll_ast in + lifting ast funs [] 0 (default_res anon_num) |> fun res -> res |> get_num diff --git a/slarnML/lib/pretty_print/pprint_ll.ml b/slarnML/lib/pretty_print/pprint_ll.ml index 0e585900c..b967faf79 100644 --- a/slarnML/lib/pretty_print/pprint_ll.ml +++ b/slarnML/lib/pretty_print/pprint_ll.ml @@ -27,7 +27,7 @@ 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); ")" ] + 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; ")" ] ;; diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index 1f8107938..9d4a84751 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -7,37 +7,31 @@ #include #include -// Maximum number of partial applications to store #define MAX_APPS 100 -// Maximum number of arguments per function #define MAX_ARGS 16 -// Structure to store function information struct Func { - uint8_t argscnt; // Total number of arguments the function expects - uint8_t cnt; // Number of arguments already applied - void *ptr; // Function pointer - int64_t *argsfun; // Array of arguments - ffi_cif *cif; // FFI call interface - ffi_type **arg_types; // FFI argument types - void **arg_values; // FFI argument values + uint8_t argscnt; + uint8_t cnt; + void *ptr; + int64_t *argsfun; + ffi_cif *cif; + ffi_type **arg_types; + void **arg_values; }; -// Initialize a new function structure struct Func func_init(void *ptr, uint8_t cnt) { struct Func new; new.ptr = ptr; new.argscnt = cnt; new.cnt = 0; - // Allocate memory for arguments new.argsfun = malloc(sizeof(int64_t) * cnt); if (!new.argsfun) { fprintf(stderr, "Memory allocation failed for arguments!\n"); exit(1); } - // Allocate memory for FFI structures new.cif = malloc(sizeof(ffi_cif)); if (!new.cif) { fprintf(stderr, "Memory allocation failed for FFI CIF!\n"); @@ -45,7 +39,6 @@ struct Func func_init(void *ptr, uint8_t cnt) { exit(1); } - // Allocate memory for argument types new.arg_types = malloc(sizeof(ffi_type*) * (cnt + 1)); // +1 for return type if (!new.arg_types) { fprintf(stderr, "Memory allocation failed for argument types!\n"); @@ -54,7 +47,6 @@ struct Func func_init(void *ptr, uint8_t cnt) { exit(1); } - // Allocate memory for argument values new.arg_values = malloc(sizeof(void*) * cnt); if (!new.arg_values) { fprintf(stderr, "Memory allocation failed for argument values!\n"); @@ -64,13 +56,11 @@ struct Func func_init(void *ptr, uint8_t cnt) { exit(1); } - // Set up argument types (all int64_t) for (int i = 0; i < cnt; i++) { new.arg_types[i] = &ffi_type_sint64; } - new.arg_types[cnt] = NULL; // Terminate the array + new.arg_types[cnt] = NULL; - // Prepare the FFI call interface ffi_status status = ffi_prep_cif(new.cif, FFI_DEFAULT_ABI, cnt, &ffi_type_sint64, new.arg_types); if (status != FFI_OK) { fprintf(stderr, "Failed to prepare FFI call interface: %d\n", status); @@ -84,7 +74,6 @@ struct Func func_init(void *ptr, uint8_t cnt) { return new; } -// Free resources associated with a function void func_free(struct Func *f) { if (f) { free(f->argsfun); @@ -94,31 +83,26 @@ void func_free(struct Func *f) { } } -// Global array to store partial applications struct Func *part_apps; uint8_t *used_apps; uint16_t last_app = 0; -// Apply a function with its stored arguments int64_t app_n(struct Func *f) { if (f == NULL || f->ptr == NULL) { fprintf(stderr, "Error: NULL pointer in app_n function\n"); return -1; } - // Set up argument values for (int i = 0; i < f->argscnt; i++) { f->arg_values[i] = &f->argsfun[i]; } - // Call the function using FFI int64_t result; ffi_call(f->cif, FFI_FN(f->ptr), &result, f->arg_values); return result; } -// Apply arguments to a function int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { if (f == NULL || args == NULL) { fprintf(stderr, "Error: NULL pointer in app function\n"); @@ -128,26 +112,21 @@ int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { uint8_t f_cnt = f->cnt; uint8_t new_cnt = f_cnt + cnt; - // Store the new arguments for (int i = f_cnt; i < new_cnt && i < f->argscnt; i++) { f->argsfun[i] = args[i - f_cnt]; } - // Update the count of applied arguments f->cnt = (new_cnt < f->argscnt) ? new_cnt : f->argscnt; - // If we have all arguments, call the function if (f->cnt >= f->argscnt) { int64_t ret = app_n(f); - // If there are more arguments than needed, create a new partial application if (new_cnt > f->argscnt) { int64_t new_args[MAX_ARGS]; for (int i = 0; i < new_cnt - f->argscnt && i < MAX_ARGS; i++) { new_args[i] = args[i + (f->argscnt - f_cnt)]; } - // Create a new function with the remaining arguments struct Func *new_f = &part_apps[last_app]; *new_f = func_init(f->ptr, f->argscnt); last_app = (last_app + 1) % MAX_APPS; @@ -158,46 +137,36 @@ int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { return ret; } - // Return the function pointer as an integer return (int64_t)f; } -// Main function for partial application int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { int64_t args[MAX_ARGS]; va_list argptr; va_start(argptr, appcnt); - // Get the arguments from the variable argument list for (int i = 0; i < appcnt && i < MAX_ARGS; i++) { args[i] = va_arg(argptr, int64_t); } va_end(argptr); - // Check if f_ptr is a valid function pointer if (f_ptr == NULL) { fprintf(stderr, "Error: NULL function pointer\n"); return -1; } - // Check if f_ptr is within the part_apps array if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS-1]) { - // If it's already a partial application, copy it part_apps[last_app] = *(struct Func *)f_ptr; } else { - // Initialize a new function part_apps[last_app] = func_init(f_ptr, argcnt); used_apps[last_app] = 1; } - // Update last_app and ensure it's within bounds last_app = (last_app + 1) % MAX_APPS; - // Call the function with the arguments return app(&part_apps[last_app-1], appcnt, args); } -// Initialize the partial applications array void init_part_apps() { part_apps = malloc(sizeof(struct Func) * MAX_APPS); if (!part_apps) { @@ -210,7 +179,6 @@ void init_part_apps() { exit(1); } - // Initialize all function pointers to NULL for (int i = 0; i < MAX_APPS; i++) { part_apps[i].ptr = NULL; part_apps[i].argsfun = NULL; @@ -223,7 +191,6 @@ void init_part_apps() { } } -// Clean up resources void cleanup_part_apps() { if (part_apps) { for (int i = 0; i < MAX_APPS; i++) { @@ -236,18 +203,22 @@ void cleanup_part_apps() { } } -// // Example function with many arguments +#include +void print_int2(int number) { + printf("%d", number); +} + + // 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; // } -// // Example function with two arguments + // int fun(int a, int b) { // return (10 * a + b); // } -// // Example function with no arguments // 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..af2dcee19 100644 --- a/slarnML/lib/riscv64/print.S +++ b/slarnML/lib/riscv64/print.S @@ -61,7 +61,7 @@ print_uint: ld ra,56(sp) ld s0,48(sp) addi sp,sp,64 - ret + ret # make the syscall print_int: addi sp,sp,-48 diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index fc935a2ee..e91d7d84d 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -454,10 +454,10 @@ let rec build_aexpr tag a res = | 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 + | AGte (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Bge, r1, r2, tag)) i1 i2 + | ALte (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Ble, r1, r2, tag)) i1 i2 + | AGt (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Bgt, r1, r2, tag)) i1 i2 + | ALt (i1, i2) -> cond_op (fun r1 r2 -> Bnch (Blt, r1, r2, tag)) i1 i2 | ANot i -> res |> load_imm f i @@ -549,7 +549,7 @@ let rec build_aexpr tag a res = res >>= (fun env -> Result ([], None, env) - |> build_aexpr tag e1 + |> build_aexpr tag e2 >>= fun (instr1, reg1, env) -> (match reg1 with | Some reg when reg <> A 0 -> @@ -565,7 +565,7 @@ let rec build_aexpr tag a res = @ [ Jmp (get_true_tag_addr id); Tag (get_tag id) ] , Some (A 0) , env )) - |> build_aexpr tag e2 + |> build_aexpr tag e1 >>= fun (instr1, reg2, env) -> (match reg2 with | Some reg when reg <> A 0 -> diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index cfcaf972c..39c5beecc 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -4,7 +4,7 @@ > (fack n (fun x -> x)) > ;; > EOF - (fun anon$1(x)-> + (fun anon$1(n f n x)-> (let anf_app#1=(f n) in (let anf_op#2=(x*anf_app#1) @@ -22,19 +22,23 @@ ) else ( (let anf_op#6=(n-1) in - (let anf_app#7=(fack anf_op#6 anon$1) + (let anf_app#7=(anon$1 n f n) in - anf_app#7))) + (let anf_app#8=(fack anf_op#6 anf_app#7) + in + anf_app#8)))) in anf_if#4)) ) - (fun anon$2(x)-> + (fun anon$2(n x)-> x ) (fun fac(n)-> - (let anf_app#8=(fack n anon$2) + (let anf_app#9=(anon$2 n) + in + (let anf_app#10=(fack n anf_app#9) in - anf_app#8) + anf_app#10)) ) $ dune exec anf_conv_test << EOF > let fac n = @@ -73,58 +77,42 @@ > (g 2 3) > EOF (fun h(c d a e)-> - (let anf_app#1=(a ) - in - (let anf_app#2=(c ) - in - (let anf_app#3=(d ) + (let anf_op#1=(d*e) in - (let anf_app#4=(e ) + (let anf_op#2=(c+anf_op#1) in - (let anf_op#5=(anf_app#3*anf_app#4) + (let anf_op#3=(a*anf_op#2) 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))))))) + anf_op#3))) ) (fun g(a c d)-> - (let anf_app#8=(h c d a 4) + (let anf_app#4=(h c d a c d a 4) in - anf_app#8) + anf_app#4) ) (fun f(a)-> - (let anf_app#9=(g a 2 3) + (let anf_app#5=(g a a 2 3) in - anf_app#9) + anf_app#5) ) $ dune exec anf_conv_test < manytests/do_not_type/001.ml Id fac not found in env (fun recfac(n)-> - (let anf_app#1=(n ) - in - (let anf_op#2=(anf_app#1<=1) + (let anf_op#1=(n<=1) in - (let anf_if#3=if (anf_op#2) + (let anf_if#2=if (anf_op#1) then ( 1 ) else ( - (let anf_app#4=(n ) - in - (let anf_app#5=(n ) - in - (let anf_app#6=(n ) - in - (let anf_op#7=(anf_app#6-1) + (let anf_op#3=(n-1) in - (let anf_app#8=(fac anf_app#5 anf_op#7) + (let anf_app#4=(fac n anf_op#3) in - (let anf_op#9=(anf_app#4*anf_app#8) + (let anf_op#5=(n*anf_app#4) in - anf_op#9))))))) + anf_op#5)))) in - anf_if#3))) + anf_if#2)) ) $ dune exec anf_conv_test < manytests/do_not_type/002if.ml (fun main()-> @@ -138,28 +126,34 @@ ) $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml Id f not found in env - (fun anon$2(f)-> - (let anf_app#1=(x f x f) + (fun anon$2(x f)-> + (let anf_app#1=(x x f) in anf_app#1) ) (fun anon$1(f x)-> - (let anf_app#2=(f anon$2) + (let anf_app#2=(anon$2 x f) + in + (let anf_app#3=(f anf_app#2) in - anf_app#2) + anf_app#3)) ) (fun fix(f)-> - anon$1 + (let anf_app#4=(anon$1 f) + in + anf_app#4) ) - (fun anon$4(f)-> - (let anf_app#3=(x x f) + (fun anon$4(x f)-> + (let anf_app#5=(x x f) in - anf_app#3) + anf_app#5) ) (fun anon$3(x)-> - (let anf_app#4=(f x anon$4) + (let anf_app#6=(anon$4 x) in - anf_app#4) + (let anf_app#7=(f x anf_app#6) + in + anf_app#7)) ) $ dune exec anf_conv_test < manytests/typed/001fac.ml (fun fac(n)-> @@ -189,7 +183,7 @@ 0))) ) $ dune exec anf_conv_test < manytests/typed/002fac.ml - (fun anon$1(p)-> + (fun anon$1(n k p)-> (let anf_op#1=(p*n) in (let anf_app#2=(k anf_op#1) @@ -207,9 +201,11 @@ ) else ( (let anf_op#6=(n-1) in - (let anf_app#7=(fac_cps anf_op#6 anon$1) + (let anf_app#7=(anon$1 n k) + in + (let anf_app#8=(fac_cps anf_op#6 anf_app#7) in - anf_app#7))) + anf_app#8)))) in anf_if#4)) ) @@ -217,13 +213,15 @@ print_int ) (fun main()-> - (let anf_app#8=(fac_cps 4 anon$2) + (let anf_app#9=(anon$2 ) + in + (let anf_app#10=(fac_cps 4 anf_app#9) in - (let anf_app#9=(print_int anf_app#8) + (let anf_app#11=(print_int anf_app#10) in - (let anf_()#10=anf_app#9 + (let anf_()#12=anf_app#11 in - 0))) + 0)))) ) $ dune exec anf_conv_test < manytests/typed/003fib.ml (fun n1(a b n)-> @@ -243,45 +241,49 @@ then ( b ) else ( - (let anf_app#5=(fib_acc b ab n1) + (let anf_app#5=(ab a b n) in - anf_app#5)) + (let anf_app#6=(n1 a b n) + in + (let anf_app#7=(fib_acc b anf_app#5 anf_app#6) + in + anf_app#7)))) in anf_if#4)) ) (fun fib(n)-> - (let anf_op#6=(n<2) + (let anf_op#8=(n<2) in - (let anf_if#7=if (anf_op#6) + (let anf_if#9=if (anf_op#8) then ( n ) else ( - (let anf_op#8=(n-1) + (let anf_op#10=(n-1) in - (let anf_op#9=(n-2) + (let anf_app#11=(fib anf_op#10) in - (let anf_app#10=(fib anf_op#9) + (let anf_op#12=(n-2) in - (let anf_op#11=(anf_op#8+anf_app#10) + (let anf_app#13=(fib anf_op#12) in - (let anf_app#12=(fib anf_op#11) + (let anf_op#14=(anf_app#11+anf_app#13) in - anf_app#12)))))) + anf_op#14)))))) in - anf_if#7)) + anf_if#9)) ) (fun main()-> - (let anf_app#13=(fib_acc 0 1 4) + (let anf_app#15=(fib_acc 0 1 4) in - (let anf_app#14=(print_int anf_app#13) + (let anf_app#16=(print_int anf_app#15) in - (let anf_()#15=anf_app#14 + (let anf_()#17=anf_app#16 in - (let anf_app#16=(fib 4) + (let anf_app#18=(fib 4) in - (let anf_app#17=(print_int anf_app#16) + (let anf_app#19=(print_int anf_app#18) in - (let anf_()#18=anf_app#17 + (let anf_()#20=anf_app#19 in 0)))))) ) @@ -291,97 +293,65 @@ in (let anf_if#2=if (anf_op#1) then ( - (let anf_app#3=(f ) - in - anf_app#3) + f ) else ( - (let anf_app#4=(f ) - in - anf_app#4)) + f) in anf_if#2)) ) - (fun a_0(a b c)-> - (let anf_app#5=(a ) - in - (let anf_app#6=(print_int anf_app#5) - in - anf_app#6)) - ) - (fun b_0(a b c)-> - (let anf_app#7=(print_int b) - in - anf_app#7) - ) - (fun c_0(a b c)-> - (let anf_app#8=(print_int c) - in - anf_app#8) - ) (fun test3(a b c)-> - 0 - ) - (fun test10(a b c d e f g h i j)-> - (let anf_app#9=(a ) - in - (let anf_app#10=(b ) - in - (let anf_op#11=(anf_app#9+anf_app#10) + (let anf_app#3=(print_int a) in - (let anf_app#12=(c ) + (let anf_()#4=anf_app#3 in - (let anf_op#13=(anf_op#11+anf_app#12) + (let anf_app#5=(print_int b) in - (let anf_app#14=(d ) - in - (let anf_op#15=(anf_op#13+anf_app#14) - in - (let anf_app#16=(e ) + (let anf_()#6=anf_app#5 in - (let anf_op#17=(anf_op#15+anf_app#16) + (let anf_app#7=(print_int c) in - (let anf_app#18=(f ) + (let anf_()#8=anf_app#7 in - (let anf_op#19=(anf_op#17+anf_app#18) + 0)))))) + ) + (fun test10(a b c d e f g h i j)-> + (let anf_op#9=(a+b) in - (let anf_app#20=(g ) + (let anf_op#10=(anf_op#9+c) in - (let anf_op#21=(anf_op#19+anf_app#20) + (let anf_op#11=(anf_op#10+d) in - (let anf_app#22=(h ) + (let anf_op#12=(anf_op#11+e) in - (let anf_op#23=(anf_op#21+anf_app#22) + (let anf_op#13=(anf_op#12+f) in - (let anf_app#24=(i ) + (let anf_op#14=(anf_op#13+g) in - (let anf_op#25=(anf_op#23+anf_app#24) + (let anf_op#15=(anf_op#14+h) in - (let anf_app#26=(j ) + (let anf_op#16=(anf_op#15+i) in - (let anf_op#27=(anf_op#25+anf_app#26) + (let anf_op#17=(anf_op#16+j) in - anf_op#27))))))))))))))))))) + anf_op#17))))))))) ) (fun rez()-> - (let anf_app#28=(test10 ) - in - (let anf_app#29=(wrap anf_app#28 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + (let anf_app#18=(test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in - anf_app#29)) + anf_app#18) ) - (fun temp2()-> - (let anf_app#30=(test3 ) + (fun main()-> + (let anf_app#19=(rez ) in - (let anf_app#31=(wrap anf_app#30 1 10 100) + (let anf_app#20=(print_int anf_app#19) in - anf_app#31)) - ) - (fun main()-> - (let anf_app#32=(print_int rez) + (let anf_()#21=anf_app#20 in - (let anf_()#33=anf_app#32 + (let anf_app#22=(test3 1 10 100) in - 0)) + (let anf_()#23=anf_app#22 + in + 0))))) ) $ dune exec anf_conv_test < manytests/typed/005fix.ml (fun fix(f x)-> @@ -392,136 +362,124 @@ anf_app#2)) ) (fun fac(self n)-> - (let anf_app#3=(n ) - in - (let anf_op#4=(anf_app#3<=1) + (let anf_op#3=(n<=1) in - (let anf_if#5=if (anf_op#4) + (let anf_if#4=if (anf_op#3) then ( 1 ) else ( - (let anf_app#6=(n ) + (let anf_op#5=(n-1) in - (let anf_app#7=(n ) + (let anf_app#6=(self anf_op#5) in - (let anf_op#8=(anf_app#7-1) + (let anf_op#7=(n*anf_app#6) in - (let anf_app#9=(self anf_op#8) - in - (let anf_op#10=(anf_app#6*anf_app#9) - in - anf_op#10)))))) + anf_op#7)))) in - anf_if#5))) + anf_if#4)) ) (fun main()-> - (let anf_app#11=(fac ) + (let anf_app#8=(fac ) in - (let anf_app#12=(fix anf_app#11 6) + (let anf_app#9=(fix anf_app#8 6) in - (let anf_app#13=(print_int anf_app#12) + (let anf_app#10=(print_int anf_app#9) in - (let anf_()#14=anf_app#13 + (let anf_()#11=anf_app#10 in 0)))) ) $ dune exec anf_conv_test < manytests/typed/006partial.ml (fun anon$1(b foo)-> - (let anf_op#1=(foo+2) + (let anf_app#1=(foo ) in - anf_op#1) + (let anf_op#2=(anf_app#1+2) + in + anf_op#2)) ) (fun anon$2(b foo)-> - (let anf_op#2=(foo*10) + (let anf_app#3=(foo ) in - anf_op#2) + (let anf_op#4=(anf_app#3*10) + in + anf_op#4)) ) (fun foo(b)-> - (let anf_app#3=(b ) - in - (let anf_if#4=if (anf_app#3) + (let anf_if#5=if (b) then ( - anon$1 + (let anf_app#6=(anon$1 b) + in + anf_app#6) ) else ( - anon$2) + (let anf_app#7=(anon$2 b) + in + anf_app#7)) in - anf_if#4)) + anf_if#5) ) (fun foo_0(x)-> - (let anf_app#5=(x ) - in - (let anf_app#6=(foo false anf_app#5) + (let anf_app#8=(foo false x) in - (let anf_app#7=(foo true anf_app#6) + (let anf_app#9=(foo true anf_app#8) in - (let anf_app#8=(foo false anf_app#7) + (let anf_app#10=(foo false anf_app#9) in - (let anf_app#9=(foo true anf_app#8) + (let anf_app#11=(foo true anf_app#10) in - anf_app#9))))) + anf_app#11)))) ) (fun main()-> - (let anf_app#10=(foo_0 11) + (let anf_app#12=(foo_0 11) in - (let anf_app#11=(print_int anf_app#10) + (let anf_app#13=(print_int anf_app#12) in - (let anf_()#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=(a ) + (let anf_app#1=(print_int a) in - (let anf_app#2=(print_int anf_app#1) + (let anf_()#2=anf_app#1 in - (let anf_()#3=anf_app#2 + (let anf_app#3=(print_int b) in - (let anf_app#4=(b ) + (let anf_()#4=anf_app#3 in - (let anf_app#5=(print_int anf_app#4) + (let anf_app#5=(print_int c) 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 ) + (let anf_op#7=(b*c) in - (let anf_op#13=(anf_app#11*anf_app#12) + (let anf_op#8=(a+anf_op#7) in - (let anf_op#14=(anf_app#10+anf_op#13) - in - anf_op#14)))))))))))))) + anf_op#8)))))))) ) (fun foo_0()-> - (let anf_app#15=(foo 1) + (let anf_app#9=(foo 1) in - anf_app#15) + anf_app#9) ) - (fun foo_0_1()-> - (let anf_app#16=(foo_0 2) + (fun foo_0_2()-> + (let anf_app#10=(foo_0 2) in - anf_app#16) + anf_app#10) ) - (fun foo_0_1_2()-> - (let anf_app#17=(foo_0_1 3) + (fun foo_0_2_4()-> + (let anf_app#11=(foo_0_2 3) in - anf_app#17) + anf_app#11) ) (fun main()-> - (let anf_app#18=(print_int foo_0_1_2) + (let anf_app#12=(foo_0_2_4 ) + in + (let anf_app#13=(print_int anf_app#12) in - (let anf_()#19=anf_app#18 + (let anf_()#14=anf_app#13 in - 0)) + 0))) ) $ dune exec anf_conv_test < manytests/typed/006partial3.ml (fun anon$2(b a c)-> @@ -534,21 +492,23 @@ in (let anf_()#3=anf_app#2 in - anon$2)) + (let anf_app#4=(anon$2 b a) + in + anf_app#4))) ) (fun foo(a)-> - (let anf_app#4=(a ) - in - (let anf_app#5=(print_int anf_app#4) + (let anf_app#5=(print_int a) in (let anf_()#6=anf_app#5 in - anon$1))) + (let anf_app#7=(anon$1 a) + in + anf_app#7))) ) (fun main()-> - (let anf_app#7=(foo 4 8 9) + (let anf_app#8=(foo 4 8 9) in - (let anf_()#8=anf_app#7 + (let anf_()#9=anf_app#8 in 0)) ) diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index 80f503a46..c8cabeb6d 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -4,7 +4,7 @@ > (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)))) + (let fac n=(let rec fack n f=if ((n<=1)) then ((f 1)) else ((fack (n-1) ((fun n f n x->(x*(f n))) n f n))) in (fack n ((fun n x->x) n)))) $ dune exec clos_conv_test << EOF > let fac n = > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in @@ -20,7 +20,7 @@ > in > (g 2 3) > EOF - (let f a=(let g a c d=(let h c a e d=(a*(c+(d*e))) in (h c a 4)) in (g a 2 3))) + (let f a=(let g a c d=(let h c a e d=(a*(c+(d*e))) in ((h c a) c a 4)) in ((g a) a 2 3))) $ dune exec clos_conv_test << EOF > let rec fac n = if n<=1 then 1 else n * fac (n-1) > @@ -34,30 +34,30 @@ (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 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 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 - (let rec fib_acc a b n=if ((n=1)) then (b) else ((let n1 a b n=(n-1) in (let ab a b n=(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 rec fib_acc a b n=if ((n=1)) then (b) else ((let n1 a b n=(n-1) in (let ab a b n=(a+b) in (fib_acc b (ab a b n) (n1 a b n)))))) + (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_0 a b c=(print_int a) in (let b_0 a b c=(print_int b) in (let c_0 a b c=(print_int c) in 0)))) + (let test3 a b c=(let ()=(print_int a) in (let ()=(print_int b) in (let ()=(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 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)))) + (let main=(let rez=(test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let ()=(print_int rez) in (let ()=(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 b foo->(foo+2))) else ((fun b foo->(foo*10)))) + (let foo b=if (b) then (((fun b foo->(foo+2)) b)) else (((fun b foo->(foo*10)) b))) (let foo_0 x=(foo true (foo false (foo true (foo false x))))) (let main=(let ()=(print_int (foo_0 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_0=(foo 1) in (let foo_0_1=(foo_0 2) in (let foo_0_1_2=(foo_0_1 3) in (let ()=(print_int foo_0_1_2) in 0))))) + (let main=(let foo_0=(foo 1) in (let foo_0_2=(foo_0 2) in (let foo_0_2_4=(foo_0_2 3) in (let ()=(print_int foo_0_2_4) in 0))))) $ dune exec clos_conv_test < manytests/typed/006partial3.ml - (let foo a=(let ()=(print_int a) in (fun a b->(let ()=(print_int b) in (fun b a c->(print_int c)))))) + (let foo a=(let ()=(print_int a) in ((fun a b->(let ()=(print_int b) in ((fun b a c->(print_int c)) b a))) a))) (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/exec_test.t_ b/slarnML/test/exec_test.t_ index 67788e52c0a24e5ad4b746ffe34fe0111395297a..a534dfc7030739253e6cd6a00a536ed5e055f01e 100644 GIT binary patch delta 168 zcmbQP^h$BV7PiebOuHHRj2R%n)ZEhC(rB_FlLeZH#QD76t~!V55Ly9Fw1L3jnQZU}RLD{GQQfvJ;Cj aNO&_dUmxS-cZ{}@CQ$P%ptL2F<^li?jwCt& literal 4375 zcmeHKU2EGg6y5WF#eFEWrO2|KQfO%Vw!vV~hdh>%DzcObWGR!SlK%T$`6D0hm)mr- zgM<*vv32j2bac)UzyTD&2oOub!KsShot;jVsl1zdQF*wyfN$5|;R@niGWiPF)WSo_ zl!43o7V1Baj^Pp(P8pBgJ*1#a`!ubu7zM8fT@Ip^2}?3Jfv^fl$sGTE=`i`6x2b?w zY?X_|4(*pDRI3?nM?vdil1YryG@lAI=e$<|xz2(7prLY9Th269hU-uWAU`+$#AHCU zlnQ?_LgkrPc;(P9ggHNDi$#JDv6k-c73El9i4A_EZ#SfNiUt%`&*C3Z2GULt_JMjd z?frU5a14t8aWx>Jb!P0GerY~+oaZrv=rH#YFctOp3sKNC%_QSVsW*YN$HK;XK7sK^ zp!pfFke}{?g?x{NNV9as1phTJOvJntCUT!OAX(5Jj<|IKb*03;e~ie!$wueD-o_gv zsb)RiU^6h*gS5dEPi&jLq#(Z5d`|uyjWlwIs*5QIcebiJ{avT0*@&VfuD%cShR&3s zx)?Wd6g7OOXfXhHK1=KvT?oivcn!|mDN3~Shhs#|QR2nYpQOt?KOO@jNl0Zx0ZvHa zgy90bh1=+I4)JYnwHDmxV-U_+HwGQw^ufh08JZ{MAtxq(BTOMpk)JNbN4Vkf(FKW{jTR2duv_SJHr4wj2 zm?@N*zrug@OX+6)0X_*XceHq|jqE(viob32b&W&o%~==nBe9V8z#y%iX1h~pfA$7p zY!8pEE%h1TG3vo%&^k7!!Tk|!b!J@=zy>Mw=;GzGBa-a<>S=R+?x`R%)=aZ)6+Gw9 Vs340H_`Zd$x{CH@HQ{R<8oj2i#| diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 6c6b6e196..8812fc469 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(x)->((x*(f n)))) - (fun fack(n f)->(if ((n<=1)) then ((f 1)) else ((fack (n-1) anon$1)))) - (fun anon$2(x)->(x)) - (fun fac(n)->((fack n anon$2))) + (fun anon$1(n f n x)->((x*{f n}))) + (fun fack(n f)->(if ((n<=1)) then ({f 1}) else ({fack (n-1) {anon$1 n f n}}))) + (fun anon$2(n x)->(x)) + (fun fac(n)->({fack n {anon$2 n}})) $ 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)->((fack n))) + (fun fack(n)->(if ((n<1)) then (n) else ((n*{fack (n-1)})))) + (fun fac(n)->({fack n})) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -24,66 +24,62 @@ > in > (g 2 3) > EOF - (fun h(c d a e)->(((a )*((c )+((d )*(e )))))) - (fun g(a c d)->((h c d a 4))) - (fun f(a)->((g a 2 3))) + (fun h(c d a e)->((a*(c+(d*e))))) + (fun g(a c d)->({h c d a c d a 4})) + (fun f(a)->({g a a 2 3})) $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml Id fac not found in env - (fun recfac(n)->(if (((n )<=1)) then (1) else (((n )*(fac (n ) ((n )-1)))))) + (fun recfac(n)->(if ((n<=1)) then (1) else ((n*{fac n (n-1)})))) $ 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 Id f not found in env - (fun anon$2(f)->((x f x f))) - (fun anon$1(f x)->((f anon$2))) - (fun fix(f)->(anon$1)) - (fun anon$4(f)->((x x f))) - (fun anon$3(x)->((f x anon$4))) + (fun anon$2(x f)->({x x f})) + (fun anon$1(f x)->({f {anon$2 x f}})) + (fun fix(f)->({anon$1 f})) + (fun anon$4(x f)->({x x f})) + (fun anon$3(x)->({f x {anon$4 x}})) $ 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))) + (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(p)->((k (p*n)))) - (fun fac_cps(n k)->(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) anon$1)))) + (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$2(print_int)->(print_int)) - (fun main()->(let () = ((print_int (fac_cps 4 anon$2)) in 0))) + (fun main()->(let () = ({print_int {fac_cps 4 {anon$2 }}} in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml (fun n1(a b n)->((n-1))) (fun ab(a b n)->((a+b))) - (fun fib_acc(a b n)->(if ((n=1)) then (b) else ((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)))) + (fun fib_acc(a b n)->(if ((n=1)) then (b) else ({fib_acc b {ab a b n} {n1 a b n}}))) + (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_0(a b c)->((print_int (a )))) - (fun b_0(a b c)->((print_int b))) - (fun c_0(a b c)->((print_int c))) - (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 rez()->((wrap (test10 ) 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000))) - (fun temp2()->((wrap (test3 ) 1 10 100))) - (fun main()->(let () = ((print_int rez) in 0))) + (fun wrap(f)->(if ((1=1)) then (f) else (f))) + (fun test3(a b c)->(let () = ({print_int a} in let () = ({print_int b} in let () = ({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 rez()->({test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000})) + (fun main()->(let () = ({print_int {rez }} in let () = ({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))) + (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(b foo)->((foo+2))) - (fun anon$2(b foo)->((foo*10))) - (fun foo(b)->(if ((b )) then (anon$1) else (anon$2))) - (fun foo_0(x)->((foo true (foo false (foo true (foo false (x ))))))) - (fun main()->(let () = ((print_int (foo_0 11)) in 0))) + (fun anon$1(b foo)->(({foo }+2))) + (fun anon$2(b foo)->(({foo }*10))) + (fun foo(b)->(if (b) then ({anon$1 b}) else ({anon$2 b}))) + (fun foo_0(x)->({foo true {foo false {foo true {foo false x}}}})) + (fun main()->(let () = ({print_int {foo_0 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_0()->((foo 1))) - (fun foo_0_1()->((foo_0 2))) - (fun foo_0_1_2()->((foo_0_1 3))) - (fun main()->(let () = ((print_int foo_0_1_2) 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_0()->({foo 1})) + (fun foo_0_2()->({foo_0 2})) + (fun foo_0_2_4()->({foo_0_2 3})) + (fun main()->(let () = ({print_int {foo_0_2_4 }} in 0))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - (fun anon$2(b a c)->((print_int c))) - (fun anon$1(a 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))) + (fun anon$2(b a c)->({print_int c})) + (fun anon$1(a b)->(let () = ({print_int b} in {anon$2 b a}))) + (fun foo(a)->(let () = ({print_int a} in {anon$1 a}))) + (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/parser_tests.t b/slarnML/test/parser_tests.t index 37f7923f8..8d45baed7 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -106,13 +106,13 @@ (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) $ dune exec parser_test < manytests/typed/003fib.ml (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 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 test3 a b c=(let ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(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 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)))) + (let main=(let rez=(test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let ()=(print_int->rez) in (let ()=(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/part_app.c b/slarnML/test/part_app.c new file mode 120000 index 000000000..7e186af3a --- /dev/null +++ b/slarnML/test/part_app.c @@ -0,0 +1 @@ +../lib/riscv64/part_app.c \ No newline at end of file diff --git a/slarnML/test/print.S b/slarnML/test/print.S new file mode 120000 index 000000000..e1f0ae463 --- /dev/null +++ b/slarnML/test/print.S @@ -0,0 +1 @@ +../lib/riscv64/print.S \ No newline at end of file diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index 9898c0fa9..ac3d4b715 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -4,7 +4,127 @@ > (fack n (fun x -> x)) > ;; > EOF - f not found + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + anon_1: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a3,-88(s0) + sd a2,-80(s0) + sd a1,-72(s0) + ld a0,-72(s0) + ld a3,-80(s0) + li a2,1 + li a1,0 + call part_app + ld a1,-88(s0) + mul a2,a1,a0 + mv a0,a2 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + fack: + 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 a0,t0,.tag_anf_op_3 + li t1,1 + sub t2,a0,t1 + sd t2,-32(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + mv a5,a3 + ld a4,-152(s0) + ld a3,-144(s0) + li a2,3 + li a1,4 + call part_app + sd a0,-40(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a4,-40(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + j .tag_anf_op_3_t + .tag_anf_op_3: + sd a0,-48(s0) + lui a0,%hi(f) + addi a0,a0,%lo(f) + li a3,1 + li a2,1 + li a1,2 + call part_app + .tag_anf_op_3_t: + sd a0,-56(s0) + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + anon_2: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a1,-32(s0) + sd a0,-24(s0) + mv a0,a1 + ld ra,24(sp) + ld s0,16(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) + addi a0,a0,%lo(anon_2) + ld a3,-88(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a4,-32(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 @@ -38,9 +158,7 @@ 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: + blt a0,t0,.tag_anf_op_1 li t1,1 sub t2,a0,t1 sd t2,-32(s0) @@ -54,6 +172,9 @@ mul t1,t2,a0 sd a0,-40(s0) mv a0,t1 + j .tag_anf_op_1_t + .tag_anf_op_1: + mv a0,t2 .tag_anf_op_1_t: mv a0,a0 ld ra,80(sp) @@ -106,43 +227,21 @@ li a7,93 ecall h: - addi sp,sp,-208 - sd ra,192(sp) - sd s0,184(sp) - addi s0,sp,208 - sd a3,-200(s0) - sd a2,-192(s0) - sd a1,-184(s0) - sd a0,-176(s0) - ld a0,-192(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-32(s0) - ld a0,-176(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-184(s0) - li a2,0 - li a1,0 - call part_app + 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) - ld a0,-200(s0) - li a2,0 - li a1,0 - call part_app - ld a1,-48(s0) - mul a2,a1,a0 - ld a3,-40(s0) - add t0,a3,a2 - ld t1,-32(s0) - mul t2,t1,t0 + mul t0,a1,a3 + add t1,a0,t0 + mul t2,a2,t1 mv a0,t2 - ld ra,192(sp) - ld s0,184(sp) - addi sp,sp,208 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 ret g: addi sp,sp,-80 @@ -154,11 +253,16 @@ sd a0,-56(s0) lui a0,%hi(h) addi a0,a0,%lo(h) - li a6,4 - ld a5,-56(s0) + ld t6,-56(s0) + sd t6,0(sp) + li t6,4 + sd t6,8(sp) + mv a7,a4 + mv a6,a3 + mv a5,t6 ld a4,-72(s0) ld a3,-64(s0) - li a2,4 + li a2,7 li a1,4 call part_app mv a0,a0 @@ -174,10 +278,11 @@ sd a0,-56(s0) lui a0,%hi(g) addi a0,a0,%lo(g) - li a5,3 - li a4,2 + li a6,3 + li a5,2 + mv a4,a3 ld a3,-56(s0) - li a2,3 + li a2,4 li a1,3 call part_app mv a0,a0 @@ -232,7 +337,129 @@ $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml Id f not found in env - x not found + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + anon_2: + addi sp,sp,-64 + sd ra,56(sp) + sd s0,48(sp) + addi s0,sp,64 + sd a1,-64(s0) + sd a0,-56(s0) + ld a0,-56(s0) + ld a4,-64(s0) + mv a3,a0 + li a2,2 + li a1,0 + call part_app + mv a0,a0 + ld ra,56(sp) + ld s0,48(sp) + addi sp,sp,64 + ret + anon_1: + 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(anon_2) + addi a0,a0,%lo(anon_2) + ld a4,-88(s0) + ld a3,-96(s0) + li a2,2 + li a1,2 + call part_app + sd a0,-32(s0) + ld a0,-88(s0) + ld a3,-32(s0) + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 + ret + fix: + 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) + addi a0,a0,%lo(anon_1) + ld a3,-56(s0) + li a2,1 + li a1,2 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + anon_4: + addi sp,sp,-64 + sd ra,56(sp) + sd s0,48(sp) + addi s0,sp,64 + sd a1,-64(s0) + sd a0,-56(s0) + ld a0,-56(s0) + ld a4,-64(s0) + mv a3,a0 + li a2,2 + li a1,0 + call part_app + mv a0,a0 + ld ra,56(sp) + ld s0,48(sp) + addi sp,sp,64 + ret + anon_3: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-88(s0) + lui a0,%hi(anon_4) + addi a0,a0,%lo(anon_4) + ld a3,-88(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(f) + addi a0,a0,%lo(f) + ld a4,-32(s0) + ld a3,-88(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 $ dune exec riscv64_instr_test < manytests/typed/001fac.ml .attribute unaligned_access, 0 @@ -262,25 +489,23 @@ addi s0,sp,96 sd a0,-88(s0) li t0,1 - ble t0,a0,.tag_anf_op_1 + ble a0,t0,.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,-32(s0) + sub t2,a0,t1 + sd t2,-32(s0) lui a0,%hi(fac) addi a0,a0,%lo(fac) ld a3,-32(s0) li a2,1 li a1,1 call part_app - ld t3,-88(s0) - mul t2,t3,a0 + ld t2,-88(s0) + mul t1,t2,a0 sd a0,-40(s0) - mv a0,t2 + mv a0,t1 + j .tag_anf_op_1_t + .tag_anf_op_1: + li a0,1 .tag_anf_op_1_t: mv a0,a0 ld ra,80(sp) @@ -314,15 +539,6 @@ ret $ dune exec riscv64_instr_test < manytests/typed/002fac.ml - n not found - - $ dune exec riscv64_instr_test < manytests/typed/003fib.ml - ab not found - - $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml - rez not found - - $ dune exec riscv64_instr_test < manytests/typed/005fix.ml .attribute unaligned_access, 0 .attribute stack_align, 16 .global main @@ -343,93 +559,94 @@ addi sp,sp,32 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,-32(s0) - lui a0,%hi(f) - addi a0,a0,%lo(f) - ld a4,-96(s0) + 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,-32(s0) + ld a0,-72(s0) ld a3,-32(s0) - li a2,2 - li a1,2 + li a2,1 + li a1,0 call part_app mv a0,a0 - ld ra,88(sp) - ld s0,80(sp) - addi sp,sp,96 + ld ra,72(sp) + ld s0,64(sp) + addi sp,sp,80 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_4 + 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 - sd a0,-32(s0) - mv a0,t0 - j .tag_anf_op_4_t - .tag_anf_op_4: - ld a0,-192(s0) - li a2,0 - li a1,0 + beq a0,t0,.tag_anf_op_3 + li t1,1 + sub t2,a0,t1 + sd t2,-32(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a4,-152(s0) + ld a3,-144(s0) + li a2,2 + li a1,3 call part_app sd a0,-40(s0) - ld a0,-192(s0) - li a2,0 - li a1,0 + 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 - li t0,1 - sub a1,a0,t0 + j .tag_anf_op_3_t + .tag_anf_op_3: sd a0,-48(s0) - sd a1,-56(s0) - ld a0,-184(s0) - ld a3,-56(s0) + ld a0,-152(s0) + li a3,1 li a2,1 li a1,0 call part_app - ld a1,-40(s0) - mul t0,a1,a0 - sd a0,-64(s0) - mv a0,t0 - .tag_anf_op_4_t: + .tag_anf_op_3_t: + sd a0,-56(s0) + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + anon_2: + 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,184(sp) - ld s0,176(sp) - addi sp,sp,192 + ld ra,16(sp) + ld s0,8(sp) + addi sp,sp,32 ret main2: addi sp,sp,-128 sd ra,112(sp) sd s0,104(sp) addi s0,sp,128 - lui a0,%hi(fac) - addi a0,a0,%lo(fac) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) li a2,0 - li a1,2 + li a1,1 call part_app sd a0,-32(s0) - lui a0,%hi(fix) - addi a0,a0,%lo(fix) - li a4,6 - ld a3,-32(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-32(s0) + li a3,4 li a2,2 li a1,2 call part_app @@ -448,14 +665,867 @@ addi sp,sp,128 ret - $ dune exec riscv64_instr_test < manytests/typed/006partial.ml - anon$1 not found + $ dune exec riscv64_instr_test < manytests/typed/003fib.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + n1: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + sd a2,-48(s0) + sd a1,-40(s0) + sd a0,-32(s0) + li t0,1 + sub t1,a2,t0 + mv a0,t1 + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret + ab: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + sd a2,-48(s0) + sd a1,-40(s0) + sd a0,-32(s0) + add t0,a0,a1 + mv a0,t0 + ld ra,40(sp) + ld s0,32(sp) + addi sp,sp,48 + ret + fib_acc: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a2,-152(s0) + sd a1,-144(s0) + sd a0,-136(s0) + li t0,1 + beq a2,t0,.tag_anf_op_3 + lui a0,%hi(ab) + addi a0,a0,%lo(ab) + ld a5,-152(s0) + ld a4,-144(s0) + ld a3,-136(s0) + li a2,3 + li a1,3 + call part_app + sd a0,-32(s0) + lui a0,%hi(n1) + addi a0,a0,%lo(n1) + ld a5,-152(s0) + ld a4,-144(s0) + ld a3,-136(s0) + li a2,3 + li a1,3 + call part_app + sd a0,-40(s0) + lui a0,%hi(fib_acc) + addi a0,a0,%lo(fib_acc) + ld a5,-40(s0) + ld a4,-32(s0) + ld a3,-144(s0) + li a2,3 + li a1,3 + call part_app + j .tag_anf_op_3_t + .tag_anf_op_3: + ld t0,-144(s0) + sd a0,-48(s0) + mv a0,t0 + .tag_anf_op_3_t: + mv a0,a0 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + 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 a0,t0,.tag_anf_op_8 + li t1,1 + sub t2,a0,t1 + sd t2,-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 t2,-128(s0) + li t1,2 + sub t0,t2,t1 + sd a0,-40(s0) + sd t0,-48(s0) + lui a0,%hi(fib) + addi a0,a0,%lo(fib) + ld a3,-48(s0) + li a2,1 + li a1,1 + call part_app + ld t0,-40(s0) + add t1,t0,a0 + sd a0,-56(s0) + mv a0,t1 + j .tag_anf_op_8_t + .tag_anf_op_8: + ld a0,-128(s0) + .tag_anf_op_8_t: + mv a0,a0 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 + ret + main2: + addi sp,sp,-160 + sd ra,152(sp) + sd s0,144(sp) + addi s0,sp,160 + 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,-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) + sd a0,-48(s0) + lui a0,%hi(fib) + addi a0,a0,%lo(fib) + li a3,4 + li a2,1 + li a1,3 + call part_app + 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 + sd a0,-64(s0) + li t0,0 + mv a0,t0 + ld ra,152(sp) + ld s0,144(sp) + addi sp,sp,160 + ret - $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml - foo_0_1_2 not found + $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + wrap: + addi sp,sp,-48 + sd ra,32(sp) + sd s0,24(sp) + addi s0,sp,48 + sd a0,-40(s0) + li t0,1 + li t1,1 + beq t0,t1,.tag_anf_op_1 + j .tag_anf_op_1_t + .tag_anf_op_1: + .tag_anf_op_1_t: + mv a0,a0 + ld ra,32(sp) + ld s0,24(sp) + addi sp,sp,48 + ret + test3: + addi sp,sp,-160 + sd ra,152(sp) + sd s0,144(sp) + addi s0,sp,160 + sd a2,-160(s0) + sd a1,-152(s0) + sd a0,-144(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-144(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + sd a0,-40(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-152(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-48(s0) + sd a0,-56(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-160(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-64(s0) + li a1,0 + mv a0,a1 + ld ra,152(sp) + ld s0,144(sp) + addi sp,sp,160 + ret + test10: + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a7,-152(s0) + sd a6,-144(s0) + sd a5,-136(s0) + sd a4,-128(s0) + sd a3,-120(s0) + sd a2,-112(s0) + sd a1,-104(s0) + sd a0,-96(s0) + add t0,a0,a1 + add t1,t0,a2 + add t2,t1,a3 + add t3,t2,a4 + add t4,t3,a5 + add t5,t4,a6 + add t6,t5,a7 + ld a7,0(s0) + add a6,t6,a7 + ld a5,8(s0) + add a4,a6,a5 + mv a0,a4 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + rez: + addi sp,sp,-64 + sd ra,56(sp) + sd s0,48(sp) + addi s0,sp,64 + lui a0,%hi(test10) + addi a0,a0,%lo(test10) + li t6,100000 + sd t6,0(sp) + li t6,1000000 + sd t6,8(sp) + li t6,10000000 + sd t6,16(sp) + li t6,100000000 + sd t6,24(sp) + li t6,1000000000 + sd t6,32(sp) + li a7,10000 + li a6,1000 + li a5,100 + li a4,10 + li a3,1 + li a2,10 + li a1,10 + call part_app + mv a0,a0 + ld ra,56(sp) + ld s0,48(sp) + addi sp,sp,64 + ret + main2: + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + lui a0,%hi(rez) + addi a0,a0,%lo(rez) + li a2,0 + li a1,0 + 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) + sd a0,-48(s0) + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a5,100 + li a4,10 + li a3,1 + li a2,3 + li a1,3 + call part_app + sd a0,-56(s0) + li t0,0 + mv a0,t0 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 + ret - $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml - anon$2 not found + $ dune exec riscv64_instr_test < manytests/typed/005fix.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + 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,-32(s0) + lui a0,%hi(f) + addi a0,a0,%lo(f) + ld a4,-96(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 + 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 a1,t0,.tag_anf_op_3 + li t1,1 + sub t2,a1,t1 + sd t2,-32(s0) + ld a0,-88(s0) + ld a3,-32(s0) + li a2,1 + li a1,0 + call part_app + ld t2,-96(s0) + mul t1,t2,a0 + sd a0,-40(s0) + mv a0,t1 + j .tag_anf_op_3_t + .tag_anf_op_3: + li a0,1 + .tag_anf_op_3_t: + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 + ret + main2: + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 + lui a0,%hi(fac) + addi a0,a0,%lo(fac) + li a2,0 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(fix) + addi a0,a0,%lo(fix) + li a4,6 + ld a3,-32(s0) + li a2,2 + li a1,2 + call part_app + sd a0,-40(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-40(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-48(s0) + li t0,0 + mv a0,t0 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 + ret + + $ dune exec riscv64_instr_test < manytests/typed/006partial.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + anon_1: + addi sp,sp,-80 + sd ra,64(sp) + sd s0,56(sp) + addi s0,sp,80 + sd a1,-72(s0) + sd a0,-64(s0) + ld a0,-72(s0) + li a2,0 + li a1,0 + call part_app + li a1,2 + add t0,a0,a1 + mv a0,t0 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret + anon_2: + addi sp,sp,-80 + sd ra,64(sp) + sd s0,56(sp) + addi s0,sp,80 + sd a1,-72(s0) + sd a0,-64(s0) + ld a0,-72(s0) + li a2,0 + li a1,0 + call part_app + li a1,10 + mul t0,a0,a1 + mv a0,t0 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + 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) + addi a0,a0,%lo(anon_1) + ld a3,-96(s0) + li a2,1 + li a1,2 + 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) + ld a3,-96(s0) + li a2,1 + li a1,2 + call part_app + .tag_if_bnch_t: + sd a0,-40(s0) + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 + ret + foo_0: + 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,-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,144(sp) + ld s0,136(sp) + addi sp,sp,160 + ret + main2: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + lui a0,%hi(foo_0) + addi a0,a0,%lo(foo_0) + li a3,11 + li a2,1 + li a1,1 + 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) + li t0,0 + mv a0,t0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + + $ dune exec riscv64_instr_test < manytests/typed/006partial2.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + foo: + addi sp,sp,-176 + sd ra,168(sp) + sd s0,160(sp) + addi s0,sp,176 + sd a2,-176(s0) + sd a1,-168(s0) + sd a0,-160(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-160(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + sd a0,-40(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-168(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-48(s0) + sd a0,-56(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-176(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-64(s0) + ld a1,-168(s0) + ld a2,-176(s0) + mul t0,a1,a2 + ld t1,-160(s0) + add t2,t1,t0 + mv a0,t2 + ld ra,168(sp) + ld s0,160(sp) + addi sp,sp,176 + ret + foo_0: + 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_0_2: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + lui a0,%hi(foo_0) + addi a0,a0,%lo(foo_0) + li a3,2 + 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_0_2_4: + addi sp,sp,-48 + sd ra,40(sp) + sd s0,32(sp) + addi s0,sp,48 + lui a0,%hi(foo_0_2) + addi a0,a0,%lo(foo_0_2) + li a3,3 + 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 + main2: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + lui a0,%hi(foo_0_2_4) + addi a0,a0,%lo(foo_0_2_4) + li a2,0 + li a1,0 + 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) + li t0,0 + mv a0,t0 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + + $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + anon_2: + 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(print_int) + addi a0,a0,%lo(print_int) + ld a3,-72(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret + anon_1: + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + sd a1,-104(s0) + sd a0,-96(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-104(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + sd a0,-40(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + ld a4,-96(s0) + ld a3,-104(s0) + li a2,2 + li a1,3 + call part_app + mv a0,a0 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 + ret + foo: + addi sp,sp,-96 + sd ra,88(sp) + sd s0,80(sp) + addi s0,sp,96 + sd a0,-96(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-96(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) + sd a0,-40(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a3,-96(s0) + li a2,1 + li a1,2 + call part_app + mv a0,a0 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 + ret + main2: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + 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,-32(s0) + li t0,0 + mv a0,t0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret $ dune exec riscv64_instr_test < manytests/typed/007order.ml : end_of_input From cfba31c9e73b2346159300748f2e3de67c545b58 Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 14 Apr 2025 00:04:43 +0300 Subject: [PATCH 31/45] Rewrite app func --- slarnML/lib/anf/anf_conv.ml | 16 +- slarnML/lib/anf/clos_conv.ml | 2 + slarnML/lib/anf/lambda_lifting.ml | 70 +- slarnML/lib/anf/ll_ast.ml | 2 +- slarnML/lib/pretty_print/pprint_ll.ml | 2 +- slarnML/lib/riscv64/part_app.c | 47 +- slarnML/test/anf_conv_test.t | 487 ++++++++--- slarnML/test/clos_conv_test.t | 4 +- slarnML/test/exec_test.t_ | Bin 4330 -> 4330 bytes slarnML/test/lambda_lifting_test.t | 55 +- slarnML/test/parser_tests.t | 4 +- slarnML/test/riscv64_instr_test.t | 1161 +++++++++++++------------ 12 files changed, 1084 insertions(+), 766 deletions(-) diff --git a/slarnML/lib/anf/anf_conv.ml b/slarnML/lib/anf/anf_conv.ml index a82ea1fb6..a93a53faa 100644 --- a/slarnML/lib/anf/anf_conv.ml +++ b/slarnML/lib/anf/anf_conv.ml @@ -58,24 +58,26 @@ let rec anf_expr e expr_with_hole = 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) -> + | LApp (func, arg :: args) -> + anf_expr func (fun func_imm -> 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))) + ALet (name, AApp (func_imm, List.rev (imm :: lst)), expr_with_hole (AId name))) args) [] - imm_arg) - | LApp (id, []) -> + imm_arg)) + | LApp (func, []) -> + anf_expr func (fun func_imm -> let name = get_name "anf_app" in - ALet (name, AApp (AId id, []), expr_with_hole (AId name)) + ALet (name, AApp (func_imm, []), expr_with_hole (AId name))) | LIn (id, e1, e2) -> anf_expr e1 (fun limm -> - let name = "anf_" ^ get_name id in - ALet (name, CImmExpr limm, anf_expr e2 expr_with_hole)) + (* let name = "anf_" ^ get_name id in *) + ALet (id, CImmExpr 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 41f373ef2..345a78ab0 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -75,6 +75,8 @@ let rec closure_conversion ?(env=[]) ?(prt_args=[]) = function CApp (func_converted, prt_args@args_converted) ;; + + let clos_conv ast = List.fold_left (fun cc_ast ast -> diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 4d8e60c6d..7fe3f9f21 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -16,12 +16,12 @@ let get_name id _ = if String.contains id '#' then String.sub id 0 (String.index id '#') else id ;; -let find_name fun_ids id = +let find_name args fun_ids id = map (fun (_, _, env, _) -> (* print_endline ("find_name " ^ id ^ " " ^ String.concat ", " fun_ids); *) match List.find_opt (fun (_, name, _) -> name = id) env with - | None -> if List.mem id fun_ids then Result (LApp (id, [])) else Result (LId id) - | Some (_, _, new_name) -> if List.mem id fun_ids then Result (LApp (new_name, [])) else Result (LId new_name)) + | None -> if List.mem id fun_ids then Result (LApp (LId id, [])) else Result (LId id) + | Some (_, _, new_name) -> if (List.mem id fun_ids && not (List.mem new_name args)) then Result (LApp (LId new_name, [])) else Result (LId new_name)) ;; let insert_let a = map (fun (ast, lst, env, num) -> Result (ast, a :: lst, env, num)) @@ -51,14 +51,14 @@ let filter lvl = Result (ast, prog, List.filter (fun (l, _, _) -> l < lvl) env, num)) ;; -let rec lifting cc_ast fun_ids stack lvl res = +let rec lifting cc_ast fun_ids g_args stack lvl res = let lifting_bin_op f e1 e2 = res - |> lifting e1 fun_ids stack lvl + |> lifting e1 fun_ids g_args stack lvl |> fun r1 -> r1 |> get_ast - >>= fun a1 -> r1 |> lifting e2 fun_ids stack lvl |> update_ast (fun a2 -> Result (f a1 a2)) + >>= fun a1 -> r1 |> lifting e2 fun_ids g_args stack lvl |> update_ast (fun a2 -> Result (f a1 a2)) in let get_id = function | Ast.Decl (id, _) | Ast.DeclRec (id, _) -> id @@ -76,17 +76,18 @@ let rec lifting cc_ast fun_ids stack lvl res = in let init_func d e1 res = let id = get_id d in + let args = (get_args d) @ g_args 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 :: fun_ids) (id :: stack) (lvl + 1) |> f2 + res |> f1 |> update_env_fun id stack lvl |> lifting e1 (id :: fun_ids) args (id :: stack) (lvl + 1) |> f2 in match cc_ast with - | CId id -> res |> find_name fun_ids id >>= fun ast -> update_ast (fun _ -> Result ast) res + | CId id -> res |> find_name g_args fun_ids id >>= fun ast -> update_ast (fun _ -> Result ast) res | CConst c -> update_ast (fun _ -> Result (LConst c)) res - | CNot e -> res |> lifting e fun_ids stack lvl + | CNot e -> res |> lifting e fun_ids g_args 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 @@ -100,18 +101,18 @@ let rec lifting cc_ast fun_ids stack lvl res = | CDiv (e1, e2) -> lifting_bin_op (fun a1 a2 -> LDiv (a1, a2)) e1 e2 | CIf (e1, e2, e3) -> res - |> lifting e1 fun_ids stack lvl + |> lifting e1 fun_ids g_args stack lvl |> fun r1 -> r1 |> get_ast >>= fun a1 -> r1 - |> lifting e2 fun_ids stack lvl + |> lifting e2 fun_ids g_args stack lvl |> fun r2 -> r2 |> get_ast >>= fun a2 -> - r2 |> lifting e3 fun_ids stack lvl |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) + r2 |> lifting e3 fun_ids g_args stack lvl |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) | CLet (d, e) -> (* let id = get_id d in *) res @@ -126,9 +127,9 @@ let rec lifting cc_ast fun_ids stack lvl res = r1 |> get_ast >>= fun a1 -> - (if id = "()" then r1 else r1 |> insert_let (get_fun_let (get_decl d) a1)) - |> lifting e2 (id::fun_ids) stack lvl - |> update_ast (fun a2 -> Result (if id = "()" then LIn (id, a1, a2) else a2)) + (if List.length (get_args d) = 0 then r1 else r1 |> insert_let (get_fun_let (get_decl d) a1)) + |> lifting e2 (id::fun_ids) g_args stack lvl + |> update_ast (fun a2 -> Result (LIn (id, a1, a2))) |> filter lvl | CFun (args, e) -> res @@ -140,33 +141,56 @@ let rec lifting cc_ast fun_ids stack lvl res = >>= fun name -> let new_name = get_name name stack in res - |> lifting e fun_ids (name :: stack) (lvl + 1) + |> lifting e fun_ids (args @ g_args) (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 (LApp (new_name, []))) + |> update_ast (fun _ -> Result (LApp (LId new_name, []))) | CApp (e, args) -> List.fold_left (fun r e -> r >>= fun (r, lst) -> Result r - |> lifting e fun_ids stack lvl + |> lifting e fun_ids g_args 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 fun_ids stack lvl + |> lifting e fun_ids g_args 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)) + | LId a -> Result (LApp (LId a, args)) | _ -> Error "Apply on not correct expr") ;; +let rec unwrap_app expr = + match expr with + | LApp (id, args) -> (match args with + | [] -> expr + | [arg] -> LApp (id, [unwrap_app arg]) + | fst :: args -> List.fold_left (fun app arg -> LApp (app, [unwrap_app arg])) (LApp (id, [unwrap_app fst])) args) + | LId _ | LConst _ -> expr + | LNot (e) -> LNot (unwrap_app e) + | LOr (e1, e2) -> LOr (unwrap_app e1, unwrap_app e2) + | LAnd (e1, e2) -> LAnd (unwrap_app e1, unwrap_app e2) + | LEq (e1, e2) -> LEq (unwrap_app e1, unwrap_app e2) + | LGt (e1, e2) -> LGt (unwrap_app e1, unwrap_app e2) + | LLt (e1, e2) -> LLt (unwrap_app e1, unwrap_app e2) + | LGte (e1, e2) -> LGte (unwrap_app e1, unwrap_app e2) + | LLte (e1, e2) -> LLte (unwrap_app e1, unwrap_app e2) + | LAdd (e1, e2) -> LAdd (unwrap_app e1, unwrap_app e2) + | LSub (e1, e2) -> LSub (unwrap_app e1, unwrap_app e2) + | LMul (e1, e2) -> LMul (unwrap_app e1, unwrap_app e2) + | LDiv (e1, e2) -> LDiv (unwrap_app e1, unwrap_app e2) + | LIf (e1, e2, e3) -> LIf (unwrap_app e1, unwrap_app e2, unwrap_app e3) + | LIn (id, e1, e2) -> LIn (id, unwrap_app e1, unwrap_app e2) +;; + let default_res num = Result (LId "Error", [], [], num) let lambda_lifting cc_ast = @@ -175,7 +199,7 @@ let lambda_lifting cc_ast = prev_res >>= fun (anon_num, ll_ast) -> let funs = List.map (fun e -> match e with | LFun (id, _, _) -> id) ll_ast in - lifting ast funs [] 0 (default_res anon_num) + lifting ast funs [] [] 0 (default_res anon_num) |> fun res -> res |> get_num @@ -183,4 +207,8 @@ let lambda_lifting cc_ast = (Result (0, [])) cc_ast >>= fun (_, ast) -> Result ast + >>= fun g_ast -> Result ( + List.fold_left (fun acc ast -> match ast with + | LFun (id, args, e) -> acc @ [(LFun (id, args, unwrap_app e))] + ) [] g_ast) ;; diff --git a/slarnML/lib/anf/ll_ast.ml b/slarnML/lib/anf/ll_ast.ml index 15f4d1b34..e69805a79 100644 --- a/slarnML/lib/anf/ll_ast.ml +++ b/slarnML/lib/anf/ll_ast.ml @@ -18,7 +18,7 @@ type 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 + | LApp of l_expr * l_expr list | LIn of string * l_expr * l_expr [@@deriving show { with_path = false }] diff --git a/slarnML/lib/pretty_print/pprint_ll.ml b/slarnML/lib/pretty_print/pprint_ll.ml index b967faf79..2784938b4 100644 --- a/slarnML/lib/pretty_print/pprint_ll.ml +++ b/slarnML/lib/pretty_print/pprint_ll.ml @@ -27,7 +27,7 @@ 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); "}" ] + concat "" [ "{"; pp_ll_expr e; " "; concat " " (List.map pp_ll_expr args); "}" ] | LIn (id, e1, e2) -> concat "" [ "let "; id; " = ("; pp_ll_expr e1; " in "; pp_ll_expr e2; ")" ] ;; diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index 9d4a84751..4d5caf86a 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -74,6 +74,44 @@ struct Func func_init(void *ptr, uint8_t cnt) { return new; } +struct Func copy_func(const struct Func *original) { + struct Func copy; + + copy.argscnt = original->argscnt; + copy.cnt = original->cnt; + + copy.ptr = original->ptr; + + copy.argsfun = malloc(sizeof(int64_t) * original->argscnt); + if (!copy.argsfun) { + fprintf(stderr, "Memory allocation failed for argsfun!\n"); + } + memcpy(copy.argsfun, original->argsfun, sizeof(int64_t) * original->argscnt); + + copy.cif = malloc(sizeof(ffi_cif)); + if (!copy.cif) { + fprintf(stderr, "Memory allocation failed for cif!\n"); + } + memcpy(copy.cif, original->cif, sizeof(ffi_cif)); + + copy.arg_types = malloc(sizeof(ffi_type*) * (original->argscnt + 1)); + if (!copy.arg_types) { + fprintf(stderr, "Memory allocation failed for arg_types!\n"); + } + for (int i = 0; i < original->argscnt; i++) { + copy.arg_types[i] = original->arg_types[i]; + } + copy.arg_types[original->argscnt] = NULL; + + copy.arg_values = malloc(sizeof(void*) * original->argscnt); + if (!copy.arg_values) { + fprintf(stderr, "Memory allocation failed for arg_values!\n"); + } + memcpy(copy.arg_values, original->arg_values, sizeof(void*) * original->argscnt); + + return copy; +} + void func_free(struct Func *f) { if (f) { free(f->argsfun); @@ -154,17 +192,22 @@ int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { fprintf(stderr, "Error: NULL function pointer\n"); return -1; } + int app_idx = 0; if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS-1]) { - part_apps[last_app] = *(struct Func *)f_ptr; + part_apps[last_app] = copy_func(f_ptr); + used_apps[last_app] = 1; + app_idx = last_app; + // app_idx = ((int64_t)f_ptr - (int64_t)&part_apps[0]) / sizeof(struct Func); } else { part_apps[last_app] = func_init(f_ptr, argcnt); used_apps[last_app] = 1; + app_idx = last_app; } last_app = (last_app + 1) % MAX_APPS; - return app(&part_apps[last_app-1], appcnt, args); + return app(&part_apps[app_idx], appcnt, args); } void init_part_apps() { diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 39c5beecc..70c4ee12e 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -22,11 +22,17 @@ ) else ( (let anf_op#6=(n-1) in - (let anf_app#7=(anon$1 n f n) + (let anf_app#7=(fack anf_op#6) in - (let anf_app#8=(fack anf_op#6 anf_app#7) + (let anf_app#8=(anon$1 n) in - anf_app#8)))) + (let anf_app#9=(anf_app#8 f) + in + (let anf_app#10=(anf_app#9 n) + in + (let anf_app#11=(anf_app#7 anf_app#10) + in + anf_app#11))))))) in anf_if#4)) ) @@ -34,11 +40,37 @@ x ) (fun fac(n)-> - (let anf_app#9=(anon$2 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=(fack anf_op#15) + in + (let anf_app#17=(anon$1 n) + in + (let anf_app#18=(anf_app#17 f) + in + (let anf_app#19=(anf_app#18 n) + in + (let anf_app#20=(anf_app#16 anf_app#19) + in + anf_app#20))))))) + in + (let fack=anf_if#13 + in + (let anf_app#21=(fack n) in - (let anf_app#10=(fack n anf_app#9) + (let anf_app#22=(anon$2 n) in - anf_app#10)) + (let anf_app#23=(anf_app#21 anf_app#22) + in + anf_app#23)))))) ) $ dune exec anf_conv_test << EOF > let fac n = @@ -64,9 +96,25 @@ anf_if#2)) ) (fun fac(n)-> - (let anf_app#6=(fack 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 anf_op#8) + in + (let anf_op#10=(n*anf_app#9) + in + anf_op#10)))) + in + (let fack=anf_if#7 + in + (let anf_app#11=(fack n) + in + anf_app#11)))) ) $ dune exec anf_conv_test << EOF > let f a = @@ -86,14 +134,64 @@ anf_op#3))) ) (fun g(a c d)-> - (let anf_app#4=(h c d a c d a 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=anf_op#6 + in + (let anf_app#7=(h c) + in + (let anf_app#8=(anf_app#7 d) + in + (let anf_app#9=(anf_app#8 a) + in + (let anf_app#10=(anf_app#9 c) + in + (let anf_app#11=(anf_app#10 d) + in + (let anf_app#12=(anf_app#11 a) + in + (let anf_app#13=(anf_app#12 4) + in + anf_app#13))))))))))) ) (fun f(a)-> - (let anf_app#5=(g a a 2 3) + (let anf_op#14=(d*e) in - anf_app#5) + (let anf_op#15=(c+anf_op#14) + in + (let anf_op#16=(a*anf_op#15) + in + (let h=anf_op#16 + in + (let anf_app#17=(h c) + in + (let anf_app#18=(anf_app#17 d) + in + (let anf_app#19=(anf_app#18 a) + in + (let anf_app#20=(anf_app#19 c) + in + (let anf_app#21=(anf_app#20 d) + in + (let anf_app#22=(anf_app#21 a) + in + (let anf_app#23=(anf_app#22 4) + in + (let g=anf_app#23 + in + (let anf_app#24=(g a) + in + (let anf_app#25=(anf_app#24 a) + in + (let anf_app#26=(anf_app#25 2) + in + (let anf_app#27=(anf_app#26 3) + in + anf_app#27)))))))))))))))) ) $ dune exec anf_conv_test < manytests/do_not_type/001.ml Id fac not found in env @@ -104,13 +202,15 @@ then ( 1 ) else ( - (let anf_op#3=(n-1) + (let anf_app#3=(fac n) in - (let anf_app#4=(fac n anf_op#3) + (let anf_op#4=(n-1) in - (let anf_op#5=(n*anf_app#4) + (let anf_app#5=(anf_app#3 anf_op#4) in - anf_op#5)))) + (let anf_op#6=(n*anf_app#5) + in + anf_op#6))))) in anf_if#2)) ) @@ -127,33 +227,41 @@ $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml Id f not found in env (fun anon$2(x f)-> - (let anf_app#1=(x x f) + (let anf_app#1=(x x) in - anf_app#1) + (let anf_app#2=(anf_app#1 f) + in + anf_app#2)) ) (fun anon$1(f x)-> - (let anf_app#2=(anon$2 x f) + (let anf_app#3=(anon$2 x) + in + (let anf_app#4=(anf_app#3 f) in - (let anf_app#3=(f anf_app#2) + (let anf_app#5=(f anf_app#4) in - anf_app#3)) + anf_app#5))) ) (fun fix(f)-> - (let anf_app#4=(anon$1 f) + (let anf_app#6=(anon$1 f) in - anf_app#4) + anf_app#6) ) (fun anon$4(x f)-> - (let anf_app#5=(x x f) + (let anf_app#7=(x x) in - anf_app#5) + (let anf_app#8=(anf_app#7 f) + in + anf_app#8)) ) (fun anon$3(x)-> - (let anf_app#6=(anon$4 x) + (let anf_app#9=(f x) + in + (let anf_app#10=(anon$4 x) in - (let anf_app#7=(f x anf_app#6) + (let anf_app#11=(anf_app#9 anf_app#10) in - anf_app#7)) + anf_app#11))) ) $ dune exec anf_conv_test < manytests/typed/001fac.ml (fun fac(n)-> @@ -178,7 +286,7 @@ in (let anf_app#7=(print_int anf_app#6) in - (let anf_()#8=anf_app#7 + (let ()=anf_app#7 in 0))) ) @@ -201,11 +309,15 @@ ) else ( (let anf_op#6=(n-1) in - (let anf_app#7=(anon$1 n k) + (let anf_app#7=(fac_cps anf_op#6) + in + (let anf_app#8=(anon$1 n) in - (let anf_app#8=(fac_cps anf_op#6 anf_app#7) + (let anf_app#9=(anf_app#8 k) in - anf_app#8)))) + (let anf_app#10=(anf_app#7 anf_app#9) + in + anf_app#10)))))) in anf_if#4)) ) @@ -213,15 +325,17 @@ print_int ) (fun main()-> - (let anf_app#9=(anon$2 ) + (let anf_app#11=(fac_cps 4) in - (let anf_app#10=(fac_cps 4 anf_app#9) + (let anf_app#12=(anon$2 ) in - (let anf_app#11=(print_int anf_app#10) + (let anf_app#13=(anf_app#11 anf_app#12) in - (let anf_()#12=anf_app#11 + (let anf_app#14=(print_int anf_app#13) in - 0)))) + (let ()=anf_app#14 + in + 0))))) ) $ dune exec anf_conv_test < manytests/typed/003fib.ml (fun n1(a b n)-> @@ -241,51 +355,75 @@ then ( b ) else ( - (let anf_app#5=(ab a b n) + (let anf_op#5=(n-1) + in + (let n1=anf_op#5 + in + (let anf_op#6=(a+b) + in + (let ab=anf_op#6 + in + (let anf_app#7=(fib_acc b) + in + (let anf_app#8=(ab a) + in + (let anf_app#9=(anf_app#8 b) in - (let anf_app#6=(n1 a b n) + (let anf_app#10=(anf_app#9 n) in - (let anf_app#7=(fib_acc b anf_app#5 anf_app#6) + (let anf_app#11=(anf_app#7 anf_app#10) in - anf_app#7)))) + (let anf_app#12=(n1 a) + in + (let anf_app#13=(anf_app#12 b) + in + (let anf_app#14=(anf_app#13 n) + in + (let anf_app#15=(anf_app#11 anf_app#14) + in + anf_app#15)))))))))))))) in anf_if#4)) ) (fun fib(n)-> - (let anf_op#8=(n<2) + (let anf_op#16=(n<2) in - (let anf_if#9=if (anf_op#8) + (let anf_if#17=if (anf_op#16) then ( n ) else ( - (let anf_op#10=(n-1) + (let anf_op#18=(n-1) in - (let anf_app#11=(fib anf_op#10) + (let anf_app#19=(fib anf_op#18) in - (let anf_op#12=(n-2) + (let anf_op#20=(n-2) in - (let anf_app#13=(fib anf_op#12) + (let anf_app#21=(fib anf_op#20) in - (let anf_op#14=(anf_app#11+anf_app#13) + (let anf_op#22=(anf_app#19+anf_app#21) in - anf_op#14)))))) + anf_op#22)))))) in - anf_if#9)) + anf_if#17)) ) (fun main()-> - (let anf_app#15=(fib_acc 0 1 4) + (let anf_app#23=(fib_acc 0) in - (let anf_app#16=(print_int anf_app#15) + (let anf_app#24=(anf_app#23 1) in - (let anf_()#17=anf_app#16 + (let anf_app#25=(anf_app#24 4) in - (let anf_app#18=(fib 4) + (let anf_app#26=(print_int anf_app#25) in - (let anf_app#19=(print_int anf_app#18) + (let ()=anf_app#26 in - (let anf_()#20=anf_app#19 + (let anf_app#27=(fib 4) in - 0)))))) + (let anf_app#28=(print_int anf_app#27) + in + (let ()=anf_app#28 + in + 0)))))))) ) $ dune exec anf_conv_test < manytests/typed/004manyargs.ml (fun wrap(f)-> @@ -299,18 +437,33 @@ in anf_if#2)) ) - (fun test3(a b c)-> + (fun a_0(a b c)-> (let anf_app#3=(print_int a) in - (let anf_()#4=anf_app#3 + anf_app#3) + ) + (fun b_0(a b c)-> + (let anf_app#4=(print_int b) + in + anf_app#4) + ) + (fun c_0(a b c)-> + (let anf_app#5=(print_int c) + in + anf_app#5) + ) + (fun test3(a b c)-> + (let anf_app#6=(print_int a) + in + (let a_0=anf_app#6 in - (let anf_app#5=(print_int b) + (let anf_app#7=(print_int b) in - (let anf_()#6=anf_app#5 + (let b_0=anf_app#7 in - (let anf_app#7=(print_int c) + (let anf_app#8=(print_int c) in - (let anf_()#8=anf_app#7 + (let c_0=anf_app#8 in 0)))))) ) @@ -335,105 +488,148 @@ in anf_op#17))))))))) ) - (fun rez()-> - (let anf_app#18=(test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) - in - anf_app#18) - ) (fun main()-> - (let anf_app#19=(rez ) + (let anf_app#18=(test10 ) in - (let anf_app#20=(print_int anf_app#19) + (let anf_app#19=(wrap anf_app#18) in - (let anf_()#21=anf_app#20 + (let anf_app#20=(anf_app#19 1) in - (let anf_app#22=(test3 1 10 100) + (let anf_app#21=(anf_app#20 10) in - (let anf_()#23=anf_app#22 + (let anf_app#22=(anf_app#21 100) in - 0))))) + (let anf_app#23=(anf_app#22 1000) + in + (let anf_app#24=(anf_app#23 10000) + in + (let anf_app#25=(anf_app#24 100000) + in + (let anf_app#26=(anf_app#25 1000000) + in + (let anf_app#27=(anf_app#26 10000000) + in + (let anf_app#28=(anf_app#27 100000000) + in + (let anf_app#29=(anf_app#28 1000000000) + in + (let rez=anf_app#29 + in + (let anf_app#30=(rez ) + in + (let anf_app#31=(print_int anf_app#30) + in + (let ()=anf_app#31 + in + (let anf_app#32=(test3 ) + in + (let anf_app#33=(wrap anf_app#32) + in + (let anf_app#34=(anf_app#33 1) + in + (let anf_app#35=(anf_app#34 10) + in + (let anf_app#36=(anf_app#35 100) + in + (let temp3=anf_app#36 + in + (let anf_app#37=(temp3 ) + in + (let anf_app#38=(print_int anf_app#37) + in + (let ()=anf_app#38 + in + 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) + (let anf_app#2=(f anf_app#1) in - anf_app#2)) + (let anf_app#3=(anf_app#2 x) + in + anf_app#3))) ) (fun fac(self n)-> - (let anf_op#3=(n<=1) + (let anf_op#4=(n<=1) in - (let anf_if#4=if (anf_op#3) + (let anf_if#5=if (anf_op#4) then ( 1 ) else ( - (let anf_op#5=(n-1) + (let anf_op#6=(n-1) in - (let anf_app#6=(self anf_op#5) + (let anf_app#7=(self anf_op#6) in - (let anf_op#7=(n*anf_app#6) + (let anf_op#8=(n*anf_app#7) in - anf_op#7)))) + anf_op#8)))) in - anf_if#4)) + anf_if#5)) ) (fun main()-> - (let anf_app#8=(fac ) + (let anf_app#9=(fac ) in - (let anf_app#9=(fix anf_app#8 6) + (let anf_app#10=(fix anf_app#9) in - (let anf_app#10=(print_int anf_app#9) + (let anf_app#11=(anf_app#10 6) in - (let anf_()#11=anf_app#10 + (let anf_app#12=(print_int anf_app#11) in - 0)))) + (let ()=anf_app#12 + in + 0))))) ) $ dune exec anf_conv_test < manytests/typed/006partial.ml (fun anon$1(b foo)-> - (let anf_app#1=(foo ) + (let anf_op#1=(foo+2) in - (let anf_op#2=(anf_app#1+2) - in - anf_op#2)) + anf_op#1) ) (fun anon$2(b foo)-> - (let anf_app#3=(foo ) - in - (let anf_op#4=(anf_app#3*10) + (let anf_op#2=(foo*10) in - anf_op#4)) + anf_op#2) ) (fun foo(b)-> - (let anf_if#5=if (b) + (let anf_if#3=if (b) then ( - (let anf_app#6=(anon$1 b) + (let anf_app#4=(anon$1 b) in - anf_app#6) + anf_app#4) ) else ( - (let anf_app#7=(anon$2 b) + (let anf_app#5=(anon$2 b) in - anf_app#7)) + anf_app#5)) in - anf_if#5) + anf_if#3) ) (fun foo_0(x)-> - (let anf_app#8=(foo false x) + (let anf_app#6=(foo true) in - (let anf_app#9=(foo true anf_app#8) + (let anf_app#7=(foo false) in - (let anf_app#10=(foo false anf_app#9) + (let anf_app#8=(foo true) in - (let anf_app#11=(foo true anf_app#10) + (let anf_app#9=(foo false) in - anf_app#11)))) + (let anf_app#10=(anf_app#9 x) + in + (let anf_app#11=(anf_app#8 anf_app#10) + in + (let anf_app#12=(anf_app#7 anf_app#11) + in + (let anf_app#13=(anf_app#6 anf_app#12) + in + anf_app#13)))))))) ) (fun main()-> - (let anf_app#12=(foo_0 11) + (let anf_app#14=(foo_0 11) in - (let anf_app#13=(print_int anf_app#12) + (let anf_app#15=(print_int anf_app#14) in - (let anf_()#14=anf_app#13 + (let ()=anf_app#15 in 0))) ) @@ -441,45 +637,42 @@ (fun foo(a b c)-> (let anf_app#1=(print_int a) in - (let anf_()#2=anf_app#1 + (let ()=anf_app#1 in - (let anf_app#3=(print_int b) + (let anf_app#2=(print_int b) in - (let anf_()#4=anf_app#3 + (let ()=anf_app#2 in - (let anf_app#5=(print_int c) + (let anf_app#3=(print_int c) in - (let anf_()#6=anf_app#5 + (let ()=anf_app#3 in - (let anf_op#7=(b*c) + (let anf_op#4=(b*c) in - (let anf_op#8=(a+anf_op#7) + (let anf_op#5=(a+anf_op#4) in - anf_op#8)))))))) + anf_op#5)))))))) ) - (fun foo_0()-> - (let anf_app#9=(foo 1) + (fun main()-> + (let anf_app#6=(foo 1) in - anf_app#9) - ) - (fun foo_0_2()-> - (let anf_app#10=(foo_0 2) + (let foo_0=anf_app#6 in - anf_app#10) - ) - (fun foo_0_2_4()-> - (let anf_app#11=(foo_0_2 3) + (let anf_app#7=(foo_0 2) in - anf_app#11) - ) - (fun main()-> - (let anf_app#12=(foo_0_2_4 ) + (let foo_0_2=anf_app#7 in - (let anf_app#13=(print_int anf_app#12) + (let anf_app#8=(foo_0_2 3) in - (let anf_()#14=anf_app#13 + (let foo_0_2_4=anf_app#8 in - 0))) + (let anf_app#9=(foo_0_2_4 ) + in + (let anf_app#10=(print_int anf_app#9) + in + (let ()=anf_app#10 + in + 0))))))))) ) $ dune exec anf_conv_test < manytests/typed/006partial3.ml (fun anon$2(b a c)-> @@ -490,27 +683,33 @@ (fun anon$1(a b)-> (let anf_app#2=(print_int b) in - (let anf_()#3=anf_app#2 + (let ()=anf_app#2 in - (let anf_app#4=(anon$2 b a) + (let anf_app#3=(anon$2 b) in - anf_app#4))) + (let anf_app#4=(anf_app#3 a) + in + anf_app#4)))) ) (fun foo(a)-> (let anf_app#5=(print_int a) in - (let anf_()#6=anf_app#5 + (let ()=anf_app#5 in - (let anf_app#7=(anon$1 a) + (let anf_app#6=(anon$1 a) in - anf_app#7))) + anf_app#6))) ) (fun main()-> - (let anf_app#8=(foo 4 8 9) + (let anf_app#7=(foo 4) + in + (let anf_app#8=(anf_app#7 8) in - (let anf_()#9=anf_app#8 + (let anf_app#9=(anf_app#8 9) in - 0)) + (let ()=anf_app#9 + 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 c8cabeb6d..bc4d46346 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -42,9 +42,9 @@ (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 ()=(print_int a) in (let ()=(print_int b) in (let ()=(print_int c) in 0)))) + (let test3 a b c=(let a_0 a b c=(print_int a) in (let b_0 a b c=(print_int b) in (let c_0 a b 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 rez=(test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let ()=(print_int rez) in (let ()=(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 temp3=(wrap test3 1 10 100) in (let ()=(print_int temp3) 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/exec_test.t_ b/slarnML/test/exec_test.t_ index a534dfc7030739253e6cd6a00a536ed5e055f01e..4449e3f8a733b1e1647e66ab8fa4a954a48cba42 100644 GIT binary patch delta 53 zcmaE*_)2j@1qZ8zfw`&CWJ4y4&09GxGfsA9i<|t9k7M&Yu2YOGhK5E)ll7Ubz#{*6 H-Y^3I{M!=- delta 91 zcmaE*_)2j@1qZ9SrMaciWJ4y4&09GxGb$SzGJt_03_!RHh6Ye^1B1zWOxBbC@o{W^ W$90O4&D6rcz!+=*SnMCq8)g91M;3Gd diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 8812fc469..e868e6123 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -5,9 +5,9 @@ > ;; > EOF (fun anon$1(n f n x)->((x*{f n}))) - (fun fack(n f)->(if ((n<=1)) then ({f 1}) else ({fack (n-1) {anon$1 n f n}}))) + (fun fack(n f)->(if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon$1 n} f} n}}))) (fun anon$2(n x)->(x)) - (fun fac(n)->({fack n {anon$2 n}})) + (fun fac(n)->(let fack = (if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon$1 n} f} n}}) in {{fack n} {anon$2 n}}))) $ 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(n)->(if ((n<1)) then (n) else ((n*{fack (n-1)})))) - (fun fac(n)->({fack n})) + (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 = @@ -25,61 +25,60 @@ > (g 2 3) > EOF (fun h(c d a e)->((a*(c+(d*e))))) - (fun g(a c d)->({h c d a c d a 4})) - (fun f(a)->({g a a 2 3})) + (fun g(a c d)->(let h = ((a*(c+(d*e))) in {{{{{{{h c} d} a} c} d} a} 4}))) + (fun f(a)->(let g = (let h = ((a*(c+(d*e))) in {{{{{{{h c} d} a} c} d} a} 4}) in {{{{g a} a} 2} 3}))) $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml Id fac not found in env - (fun recfac(n)->(if ((n<=1)) then (1) else ((n*{fac n (n-1)})))) + (fun recfac(n)->(if ((n<=1)) then (1) else ((n*{{fac n} (n-1)})))) $ 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 Id f not found in env - (fun anon$2(x f)->({x x f})) - (fun anon$1(f x)->({f {anon$2 x f}})) + (fun anon$2(x f)->({{x x} f})) + (fun anon$1(f x)->({f {{anon$2 x} f}})) (fun fix(f)->({anon$1 f})) - (fun anon$4(x f)->({x x f})) - (fun anon$3(x)->({f x {anon$4 x}})) + (fun anon$4(x f)->({{x x} f})) + (fun anon$3(x)->({{f x} {anon$4 x}})) $ 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 fac_cps(n k)->(if ((n=1)) then ({k 1}) else ({{fac_cps (n-1)} {{anon$1 n} k}}))) (fun anon$2(print_int)->(print_int)) - (fun main()->(let () = ({print_int {fac_cps 4 {anon$2 }}} in 0))) + (fun main()->(let () = ({print_int {{fac_cps 4} {anon$2 }}} in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml (fun n1(a b n)->((n-1))) (fun ab(a b n)->((a+b))) - (fun fib_acc(a b n)->(if ((n=1)) then (b) else ({fib_acc b {ab a b n} {n1 a b n}}))) + (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 a} b} n}} {{{n1 a} b} n}}))))) (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)))) + (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 test3(a b c)->(let () = ({print_int a} in let () = ({print_int b} in let () = ({print_int c} in 0))))) + (fun a_0(a b c)->({print_int a})) + (fun b_0(a b c)->({print_int b})) + (fun c_0(a b c)->({print_int c})) + (fun test3(a b c)->(let a_0 = ({print_int a} in let b_0 = ({print_int b} in let c_0 = ({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 rez()->({test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000})) - (fun main()->(let () = ({print_int {rez }} in let () = ({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 temp3 = ({{{{wrap {test3 }} 1} 10} 100} in let () = ({print_int {temp3 }} in 0)))))) $ dune exec lambda_lifting_test < manytests/typed/005fix.ml - (fun fix(f x)->({f {fix f} x})) + (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))) + (fun main()->(let () = ({print_int {{fix {fac }} 6}} in 0))) $ dune exec lambda_lifting_test < manytests/typed/006partial.ml - (fun anon$1(b foo)->(({foo }+2))) - (fun anon$2(b foo)->(({foo }*10))) + (fun anon$1(b foo)->((foo+2))) + (fun anon$2(b foo)->((foo*10))) (fun foo(b)->(if (b) then ({anon$1 b}) else ({anon$2 b}))) - (fun foo_0(x)->({foo true {foo false {foo true {foo false x}}}})) + (fun foo_0(x)->({{foo true} {{foo false} {{foo true} {{foo false} x}}}})) (fun main()->(let () = ({print_int {foo_0 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_0()->({foo 1})) - (fun foo_0_2()->({foo_0 2})) - (fun foo_0_2_4()->({foo_0_2 3})) - (fun main()->(let () = ({print_int {foo_0_2_4 }} in 0))) + (fun main()->(let foo_0 = ({foo 1} in let foo_0_2 = ({foo_0 2} in let foo_0_2_4 = ({foo_0_2 3} in let () = ({print_int {foo_0_2_4 }} in 0)))))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml (fun anon$2(b a c)->({print_int c})) - (fun anon$1(a b)->(let () = ({print_int b} in {anon$2 b a}))) + (fun anon$1(a b)->(let () = ({print_int b} in {{anon$2 b} a}))) (fun foo(a)->(let () = ({print_int a} in {anon$1 a}))) - (fun main()->(let () = ({foo 4 8 9} in 0))) + (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/parser_tests.t b/slarnML/test/parser_tests.t index 8d45baed7..12fbf7c9b 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -110,9 +110,9 @@ (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 ()=(print_int->a) in (let ()=(print_int->b) in (let ()=(print_int->c) in 0)))) + (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 rez=(test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let ()=(print_int->rez) in (let ()=(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 temp3=(wrap->test3->1->10->100) in (let ()=(print_int->temp3) 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 ac3d4b715..100040cdf 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -4,127 +4,7 @@ > (fack n (fun x -> x)) > ;; > EOF - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global main - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main2 - sd a0,24(sp) - call cleanup_part_apps - ld a0,24(sp) - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - li a7,93 - ecall - anon_1: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a3,-88(s0) - sd a2,-80(s0) - sd a1,-72(s0) - ld a0,-72(s0) - ld a3,-80(s0) - li a2,1 - li a1,0 - call part_app - ld a1,-88(s0) - mul a2,a1,a0 - mv a0,a2 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 - ret - fack: - 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 a0,t0,.tag_anf_op_3 - li t1,1 - sub t2,a0,t1 - sd t2,-32(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - mv a5,a3 - ld a4,-152(s0) - ld a3,-144(s0) - li a2,3 - li a1,4 - call part_app - sd a0,-40(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a4,-40(s0) - ld a3,-32(s0) - li a2,2 - li a1,2 - call part_app - j .tag_anf_op_3_t - .tag_anf_op_3: - sd a0,-48(s0) - lui a0,%hi(f) - addi a0,a0,%lo(f) - li a3,1 - li a2,1 - li a1,2 - call part_app - .tag_anf_op_3_t: - sd a0,-56(s0) - mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 - ret - anon_2: - addi sp,sp,-32 - sd ra,24(sp) - sd s0,16(sp) - addi s0,sp,32 - sd a1,-32(s0) - sd a0,-24(s0) - mv a0,a1 - ld ra,24(sp) - ld s0,16(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) - addi a0,a0,%lo(anon_2) - ld a3,-88(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-32(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a4,-32(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 @@ -182,21 +62,43 @@ 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) + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a0,-128(s0) + li t0,1 + blt a0,t0,.tag_anf_op_6 + li t1,1 + sub t2,a0,t1 + sd t2,-32(s0) lui a0,%hi(fack) addi a0,a0,%lo(fack) - ld a3,-56(s0) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + ld t2,-128(s0) + mul t1,t2,a0 + sd a0,-40(s0) + mv a0,t1 + j .tag_anf_op_6_t + .tag_anf_op_6: + mv a0,t2 + .tag_anf_op_6_t: + sd a0,-48(s0) + sd t1,-56(s0) + sd a0,-64(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-128(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,120(sp) + ld s0,112(sp) + addi sp,sp,128 ret $ dune exec riscv64_instr_test << EOF > let f a = @@ -206,90 +108,7 @@ > in > (g 2 3) > EOF - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global main - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main2 - sd a0,24(sp) - call cleanup_part_apps - ld a0,24(sp) - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - li a7,93 - ecall - h: - 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,a1,a3 - add t1,a0,t0 - mul t2,a2,t1 - mv a0,t2 - ld ra,64(sp) - ld s0,56(sp) - addi sp,sp,80 - ret - g: - 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) - addi a0,a0,%lo(h) - ld t6,-56(s0) - sd t6,0(sp) - li t6,4 - sd t6,8(sp) - mv a7,a4 - mv a6,a3 - mv a5,t6 - ld a4,-72(s0) - ld a3,-64(s0) - li a2,7 - 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) - addi a0,a0,%lo(g) - li a6,3 - li a5,2 - mv a4,a3 - ld a3,-56(s0) - li a2,4 - 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/do_not_type/001.ml Id fac not found in env fac not found @@ -358,40 +177,20 @@ li a7,93 ecall anon_2: - addi sp,sp,-64 - sd ra,56(sp) - sd s0,48(sp) - addi s0,sp,64 - sd a1,-64(s0) - sd a0,-56(s0) - ld a0,-56(s0) - ld a4,-64(s0) - mv a3,a0 - li a2,2 - li a1,0 - call part_app - mv a0,a0 - ld ra,56(sp) - ld s0,48(sp) - addi sp,sp,64 - ret - anon_1: 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(anon_2) - addi a0,a0,%lo(anon_2) - ld a4,-88(s0) - ld a3,-96(s0) - li a2,2 - li a1,2 + ld a0,-88(s0) + mv a3,a0 + li a2,1 + li a1,0 call part_app sd a0,-32(s0) - ld a0,-88(s0) - ld a3,-32(s0) + ld a0,-32(s0) + ld a3,-96(s0) li a2,1 li a1,0 call part_app @@ -400,6 +199,36 @@ ld s0,80(sp) addi sp,sp,96 ret + anon_1: + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a1,-128(s0) + sd a0,-120(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + ld a3,-128(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + ld a3,-120(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-120(s0) + ld a3,-40(s0) + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 + ret fix: addi sp,sp,-64 sd ra,48(sp) @@ -418,47 +247,57 @@ addi sp,sp,64 ret anon_4: - addi sp,sp,-64 - sd ra,56(sp) - sd s0,48(sp) - addi s0,sp,64 - sd a1,-64(s0) - sd a0,-56(s0) - ld a0,-56(s0) - ld a4,-64(s0) + addi sp,sp,-96 + sd ra,88(sp) + sd s0,80(sp) + addi s0,sp,96 + sd a1,-96(s0) + sd a0,-88(s0) + ld a0,-88(s0) mv a3,a0 - li a2,2 + li a2,1 + li a1,0 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + ld a3,-96(s0) + li a2,1 li a1,0 call part_app mv a0,a0 - ld ra,56(sp) - ld s0,48(sp) - addi sp,sp,64 + ld ra,88(sp) + ld s0,80(sp) + addi sp,sp,96 ret anon_3: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - sd a0,-88(s0) + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 + sd a0,-120(s0) + lui a0,%hi(f) + addi a0,a0,%lo(f) + ld a3,-120(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-32(s0) lui a0,%hi(anon_4) addi a0,a0,%lo(anon_4) - ld a3,-88(s0) + ld a3,-120(s0) li a2,1 li a1,2 call part_app - sd a0,-32(s0) - lui a0,%hi(f) - addi a0,a0,%lo(f) - ld a4,-32(s0) - ld a3,-88(s0) - li a2,2 - li a1,1 + sd a0,-40(s0) + ld a0,-32(s0) + ld a3,-40(s0) + li a2,1 + li a1,0 call part_app mv a0,a0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 ret $ dune exec riscv64_instr_test < manytests/typed/001fac.ml @@ -580,46 +419,56 @@ 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 li t1,1 sub t2,a0,t1 sd t2,-32(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - 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 a2,1 li a1,2 + call part_app + sd a0,-40(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a3,-208(s0) + li a2,1 + li a1,3 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + ld a3,-216(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-56(s0) + ld a0,-40(s0) + ld a3,-56(s0) + li a2,1 + li a1,0 call part_app j .tag_anf_op_3_t .tag_anf_op_3: - sd a0,-48(s0) - ld a0,-152(s0) + sd a0,-64(s0) + ld a0,-216(s0) li a3,1 li a2,1 li a1,0 call part_app .tag_anf_op_3_t: - sd a0,-56(s0) + sd a0,-72(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_2: addi sp,sp,-32 @@ -633,36 +482,41 @@ addi sp,sp,32 ret main2: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - li a2,0 - li a1,1 - call part_app - sd a0,-32(s0) + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 lui a0,%hi(fac_cps) addi a0,a0,%lo(fac_cps) - ld a4,-32(s0) li a3,4 - li a2,2 + li a2,1 li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + li a2,0 + li a1,1 call part_app sd a0,-40(s0) + ld a0,-32(s0) + ld a3,-40(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-48(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-40(s0) + ld a3,-48(s0) li a2,1 li a1,1 call part_app - sd a0,-48(s0) + sd a0,-56(s0) li t0,0 mv a0,t0 - 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 $ dune exec riscv64_instr_test < manytests/typed/003fib.ml @@ -716,51 +570,88 @@ addi sp,sp,48 ret fib_acc: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a2,-152(s0) - sd a1,-144(s0) - sd a0,-136(s0) + addi sp,sp,-384 + sd ra,368(sp) + sd s0,360(sp) + addi s0,sp,384 + sd a2,-376(s0) + sd a1,-368(s0) + sd a0,-360(s0) li t0,1 beq a2,t0,.tag_anf_op_3 + li t1,1 + sub t2,a2,t1 + sd t2,-32(s0) + add t3,a0,a1 + sd t3,-40(s0) + sd t2,-48(s0) + sd t3,-56(s0) + lui a0,%hi(fib_acc) + addi a0,a0,%lo(fib_acc) + ld a3,-368(s0) + li a2,1 + li a1,3 + call part_app + sd a0,-64(s0) lui a0,%hi(ab) addi a0,a0,%lo(ab) - ld a5,-152(s0) - ld a4,-144(s0) - ld a3,-136(s0) - li a2,3 + ld a3,-360(s0) + li a2,1 li a1,3 call part_app - sd a0,-32(s0) + sd a0,-72(s0) + ld a0,-72(s0) + ld a3,-368(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + ld a3,-376(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-88(s0) + ld a0,-64(s0) + ld a3,-88(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-96(s0) lui a0,%hi(n1) addi a0,a0,%lo(n1) - ld a5,-152(s0) - ld a4,-144(s0) - ld a3,-136(s0) - li a2,3 + ld a3,-360(s0) + li a2,1 li a1,3 call part_app - sd a0,-40(s0) - lui a0,%hi(fib_acc) - addi a0,a0,%lo(fib_acc) - ld a5,-40(s0) - ld a4,-32(s0) - ld a3,-144(s0) - li a2,3 - li a1,3 + sd a0,-104(s0) + ld a0,-104(s0) + ld a3,-368(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-112(s0) + ld a0,-112(s0) + ld a3,-376(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-120(s0) + ld a0,-96(s0) + ld a3,-120(s0) + li a2,1 + li a1,0 call part_app j .tag_anf_op_3_t .tag_anf_op_3: - ld t0,-144(s0) - sd a0,-48(s0) - mv a0,t0 + ld t3,-368(s0) + sd a0,-128(s0) + mv a0,t3 .tag_anf_op_3_t: mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 + ld ra,368(sp) + ld s0,360(sp) + addi sp,sp,384 ret fib: addi sp,sp,-128 @@ -769,7 +660,7 @@ addi s0,sp,128 sd a0,-128(s0) li t0,2 - blt a0,t0,.tag_anf_op_8 + blt a0,t0,.tag_anf_op_16 li t1,1 sub t2,a0,t1 sd t2,-32(s0) @@ -794,56 +685,66 @@ add t1,t0,a0 sd a0,-56(s0) mv a0,t1 - j .tag_anf_op_8_t - .tag_anf_op_8: + j .tag_anf_op_16_t + .tag_anf_op_16: ld a0,-128(s0) - .tag_anf_op_8_t: + .tag_anf_op_16_t: mv a0,a0 ld ra,120(sp) ld s0,112(sp) addi sp,sp,128 ret main2: - addi sp,sp,-160 - sd ra,152(sp) - sd s0,144(sp) - addi s0,sp,160 + addi sp,sp,-224 + sd ra,216(sp) + sd s0,208(sp) + addi s0,sp,224 lui a0,%hi(fib_acc) addi a0,a0,%lo(fib_acc) - li a5,4 - li a4,1 li a3,0 - li a2,3 + li a2,1 li a1,3 call part_app sd a0,-32(s0) + ld a0,-32(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a3,4 + li a2,1 + li a1,0 + call part_app + sd a0,-48(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-32(s0) + ld a3,-48(s0) li a2,1 li a1,1 call part_app - sd a0,-40(s0) - sd a0,-48(s0) + sd a0,-56(s0) + sd a0,-64(s0) lui a0,%hi(fib) addi a0,a0,%lo(fib) li a3,4 li a2,1 li a1,3 call part_app - sd a0,-56(s0) + 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,-64(s0) + sd a0,-80(s0) li t0,0 mv a0,t0 - ld ra,152(sp) - ld s0,144(sp) - addi sp,sp,160 + ld ra,216(sp) + ld s0,208(sp) + addi sp,sp,224 ret $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml @@ -884,6 +785,63 @@ ld s0,24(sp) addi sp,sp,48 ret + a_0: + 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(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,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret + b_0: + 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(print_int) + addi a0,a0,%lo(print_int) + ld a3,-64(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret + c_0: + 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(print_int) + addi a0,a0,%lo(print_int) + ld a3,-72(s0) + li a2,1 + li a1,1 + call part_app + mv a0,a0 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret test3: addi sp,sp,-160 sd ra,152(sp) @@ -950,69 +908,147 @@ ld s0,136(sp) addi sp,sp,160 ret - rez: - addi sp,sp,-64 - sd ra,56(sp) - sd s0,48(sp) - addi s0,sp,64 + main2: + addi sp,sp,-720 + sd ra,712(sp) + sd s0,704(sp) + addi s0,sp,720 lui a0,%hi(test10) addi a0,a0,%lo(test10) - li t6,100000 - sd t6,0(sp) - li t6,1000000 - sd t6,8(sp) - li t6,10000000 - sd t6,16(sp) - li t6,100000000 - sd t6,24(sp) - li t6,1000000000 - sd t6,32(sp) - li a7,10000 - li a6,1000 - li a5,100 - li a4,10 - li a3,1 - li a2,10 + li a2,0 li a1,10 call part_app - mv a0,a0 - ld ra,56(sp) - ld s0,48(sp) - addi sp,sp,64 - ret - main2: - addi sp,sp,-128 - sd ra,120(sp) - sd s0,112(sp) - addi s0,sp,128 - lui a0,%hi(rez) - addi a0,a0,%lo(rez) + sd a0,-32(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + ld a3,-32(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + li a3,10 + li a2,1 + li a1,0 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + li a3,100 + li a2,1 + li a1,0 + call part_app + sd a0,-64(s0) + ld a0,-64(s0) + li a3,1000 + li a2,1 + li a1,0 + call part_app + sd a0,-72(s0) + ld a0,-72(s0) + li a3,10000 + li a2,1 + li a1,0 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + li a3,100000 + li a2,1 + li a1,0 + call part_app + sd a0,-88(s0) + ld a0,-88(s0) + li a3,1000000 + li a2,1 + li a1,0 + call part_app + sd a0,-96(s0) + ld a0,-96(s0) + li a3,10000000 + li a2,1 + li a1,0 + call part_app + sd a0,-104(s0) + ld a0,-104(s0) + li a3,100000000 + li a2,1 + li a1,0 + call part_app + sd a0,-112(s0) + ld a0,-112(s0) + li a3,1000000000 + li a2,1 + li a1,0 + call part_app + sd a0,-120(s0) + sd a0,-128(s0) + ld a0,-128(s0) + li a2,0 + li a1,0 + call part_app + sd a0,-136(s0) + lui a0,%hi(print_int) + addi a0,a0,%lo(print_int) + ld a3,-136(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-144(s0) + sd a0,-152(s0) + lui a0,%hi(test3) + addi a0,a0,%lo(test3) + li a2,0 + li a1,3 + call part_app + sd a0,-160(s0) + lui a0,%hi(wrap) + addi a0,a0,%lo(wrap) + ld a3,-160(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-168(s0) + ld a0,-168(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + sd a0,-176(s0) + ld a0,-176(s0) + li a3,10 + li a2,1 + li a1,0 + call part_app + sd a0,-184(s0) + ld a0,-184(s0) + li a3,100 + li a2,1 + li a1,0 + call part_app + sd a0,-192(s0) + sd a0,-200(s0) + ld a0,-200(s0) li a2,0 li a1,0 call part_app - sd a0,-32(s0) + sd a0,-208(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-32(s0) + ld a3,-208(s0) li a2,1 li a1,1 call part_app - sd a0,-40(s0) - sd a0,-48(s0) - lui a0,%hi(test3) - addi a0,a0,%lo(test3) - li a5,100 - li a4,10 - li a3,1 - li a2,3 - li a1,3 - call part_app - sd a0,-56(s0) + sd a0,-216(s0) li t0,0 mv a0,t0 - ld ra,120(sp) - ld s0,112(sp) - addi sp,sp,128 + ld ra,712(sp) + ld s0,704(sp) + addi sp,sp,720 ret $ dune exec riscv64_instr_test < manytests/typed/005fix.ml @@ -1037,30 +1073,35 @@ 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) + addi sp,sp,-128 + sd ra,120(sp) + sd s0,112(sp) + addi s0,sp,128 + sd a1,-128(s0) + sd a0,-120(s0) lui a0,%hi(fix) addi a0,a0,%lo(fix) - ld a3,-88(s0) + ld a3,-120(s0) li a2,1 li a1,2 call part_app sd a0,-32(s0) lui a0,%hi(f) addi a0,a0,%lo(f) - ld a4,-96(s0) ld a3,-32(s0) - li a2,2 + li a2,1 li a1,2 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + ld a3,-128(s0) + li a2,1 + li a1,0 call part_app mv a0,a0 - ld ra,88(sp) - ld s0,80(sp) - addi sp,sp,96 + ld ra,120(sp) + ld s0,112(sp) + addi sp,sp,128 ret fac: addi sp,sp,-96 @@ -1070,7 +1111,7 @@ sd a1,-96(s0) sd a0,-88(s0) li t0,1 - ble a1,t0,.tag_anf_op_3 + ble a1,t0,.tag_anf_op_4 li t1,1 sub t2,a1,t1 sd t2,-32(s0) @@ -1083,20 +1124,20 @@ mul t1,t2,a0 sd a0,-40(s0) mv a0,t1 - j .tag_anf_op_3_t - .tag_anf_op_3: + j .tag_anf_op_4_t + .tag_anf_op_4: li a0,1 - .tag_anf_op_3_t: + .tag_anf_op_4_t: mv a0,a0 ld ra,88(sp) ld s0,80(sp) addi sp,sp,96 ret main2: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 lui a0,%hi(fac) addi a0,a0,%lo(fac) li a2,0 @@ -1105,24 +1146,29 @@ sd a0,-32(s0) lui a0,%hi(fix) addi a0,a0,%lo(fix) - li a4,6 ld a3,-32(s0) - li a2,2 + li a2,1 li a1,2 call part_app sd a0,-40(s0) + ld a0,-40(s0) + li a3,6 + li a2,1 + li a1,0 + call part_app + sd a0,-48(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-40(s0) + ld a3,-48(s0) li a2,1 li a1,1 call part_app - sd a0,-48(s0) + sd a0,-56(s0) li t0,0 mv a0,t0 - 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 $ dune exec riscv64_instr_test < manytests/typed/006partial.ml @@ -1147,40 +1193,32 @@ li a7,93 ecall anon_1: - addi sp,sp,-80 - sd ra,64(sp) - sd s0,56(sp) - addi s0,sp,80 - sd a1,-72(s0) - sd a0,-64(s0) - ld a0,-72(s0) - li a2,0 - li a1,0 - call part_app - li a1,2 - add t0,a0,a1 - mv a0,t0 - ld ra,64(sp) - ld s0,56(sp) - addi sp,sp,80 + addi sp,sp,-48 + sd ra,32(sp) + sd s0,24(sp) + addi s0,sp,48 + sd a1,-40(s0) + sd a0,-32(s0) + li t0,2 + add t1,a1,t0 + mv a0,t1 + ld ra,32(sp) + ld s0,24(sp) + addi sp,sp,48 ret anon_2: - addi sp,sp,-80 - sd ra,64(sp) - sd s0,56(sp) - addi s0,sp,80 - sd a1,-72(s0) - sd a0,-64(s0) - ld a0,-72(s0) - li a2,0 - li a1,0 - call part_app - li a1,10 - mul t0,a0,a1 - mv a0,t0 - ld ra,64(sp) - ld s0,56(sp) - addi sp,sp,80 + addi sp,sp,-48 + sd ra,32(sp) + sd s0,24(sp) + addi s0,sp,48 + sd a1,-40(s0) + sd a0,-32(s0) + li t0,10 + mul t1,a1,t0 + mv a0,t1 + ld ra,32(sp) + ld s0,24(sp) + addi sp,sp,48 ret foo: addi sp,sp,-96 @@ -1212,46 +1250,66 @@ addi sp,sp,96 ret foo_0: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - sd a0,-152(s0) + addi sp,sp,-288 + sd ra,272(sp) + sd s0,264(sp) + addi s0,sp,288 + sd a0,-280(s0) lui a0,%hi(foo) addi a0,a0,%lo(foo) - ld a4,-152(s0) - li a3,0 - li a2,2 + li a3,1 + 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,1 - li a2,2 + li a3,0 + li a2,1 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 a3,1 + li a2,1 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 a3,0 + li a2,1 li a1,1 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + ld a3,-280(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-64(s0) + ld a0,-48(s0) + ld a3,-64(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-72(s0) + ld a0,-40(s0) + ld a3,-72(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-80(s0) + ld a0,-32(s0) + ld a3,-80(s0) + li a2,1 + li a1,0 call part_app mv a0,a0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 + ld ra,272(sp) + ld s0,264(sp) + addi sp,sp,288 ret main2: addi sp,sp,-96 @@ -1323,14 +1381,13 @@ li a1,1 call part_app sd a0,-48(s0) - sd a0,-56(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) ld a3,-176(s0) li a2,1 li a1,1 call part_app - sd a0,-64(s0) + sd a0,-56(s0) ld a1,-168(s0) ld a2,-176(s0) mul t0,a1,a2 @@ -1341,77 +1398,50 @@ ld s0,160(sp) addi sp,sp,176 ret - foo_0: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 + main2: + addi sp,sp,-208 + sd ra,200(sp) + sd s0,192(sp) + addi s0,sp,208 lui a0,%hi(foo) addi a0,a0,%lo(foo) li a3,1 li a2,1 - li a1,0 + li a1,3 call part_app - mv a0,a0 - ld ra,40(sp) - ld s0,32(sp) - addi sp,sp,48 - ret - foo_0_2: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 - lui a0,%hi(foo_0) - addi a0,a0,%lo(foo_0) + sd a0,-32(s0) + sd a0,-40(s0) + ld a0,-40(s0) li a3,2 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_0_2_4: - addi sp,sp,-48 - sd ra,40(sp) - sd s0,32(sp) - addi s0,sp,48 - lui a0,%hi(foo_0_2) - addi a0,a0,%lo(foo_0_2) + sd a0,-48(s0) + sd a0,-56(s0) + ld a0,-56(s0) li a3,3 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 - main2: - addi sp,sp,-96 - sd ra,80(sp) - sd s0,72(sp) - addi s0,sp,96 - lui a0,%hi(foo_0_2_4) - addi a0,a0,%lo(foo_0_2_4) + sd a0,-64(s0) + sd a0,-72(s0) + ld a0,-72(s0) li a2,0 li a1,0 call part_app - sd a0,-32(s0) + sd a0,-80(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-32(s0) + ld a3,-80(s0) li a2,1 li a1,1 call part_app - sd a0,-40(s0) + sd a0,-88(s0) li t0,0 mv a0,t0 - ld ra,80(sp) - ld s0,72(sp) - addi sp,sp,96 + ld ra,200(sp) + ld s0,192(sp) + addi sp,sp,208 ret $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml @@ -1455,15 +1485,15 @@ addi sp,sp,80 ret anon_1: - addi sp,sp,-112 - sd ra,96(sp) - sd s0,88(sp) - addi s0,sp,112 - sd a1,-104(s0) - sd a0,-96(s0) + addi sp,sp,-144 + sd ra,128(sp) + sd s0,120(sp) + addi s0,sp,144 + sd a1,-136(s0) + sd a0,-128(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-104(s0) + ld a3,-136(s0) li a2,1 li a1,1 call part_app @@ -1471,15 +1501,20 @@ sd a0,-40(s0) lui a0,%hi(anon_2) addi a0,a0,%lo(anon_2) - ld a4,-96(s0) - ld a3,-104(s0) - li a2,2 + ld a3,-136(s0) + li a2,1 li a1,3 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + ld a3,-128(s0) + li a2,1 + li a1,0 call part_app mv a0,a0 - ld ra,96(sp) - ld s0,88(sp) - addi sp,sp,112 + ld ra,128(sp) + ld s0,120(sp) + addi sp,sp,144 ret foo: addi sp,sp,-96 @@ -1507,24 +1542,34 @@ addi sp,sp,96 ret main2: - addi sp,sp,-64 - sd ra,48(sp) - sd s0,40(sp) - addi s0,sp,64 + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 lui a0,%hi(foo) addi a0,a0,%lo(foo) - li a5,9 - li a4,8 li a3,4 - li a2,3 + li a2,1 li a1,1 call part_app sd a0,-32(s0) + ld a0,-32(s0) + li a3,8 + li a2,1 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a3,9 + li a2,1 + li a1,0 + call part_app + sd a0,-48(s0) li t0,0 mv a0,t0 - 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 $ dune exec riscv64_instr_test < manytests/typed/007order.ml From 8c431c5d1b265d183e345c278b3bde47c15997b7 Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 14 Apr 2025 10:38:54 +0300 Subject: [PATCH 32/45] Fix seg fault in part app --- slarnML/lib/anf/lambda_lifting.ml | 10 +- slarnML/lib/riscv64/part_app.c | 31 ++- slarnML/lib/riscv64/riscv.ml | 7 +- slarnML/test/anf_conv_test.t | 34 ++- slarnML/test/exec_test.t_ | Bin 4330 -> 4339 bytes slarnML/test/lambda_lifting_test.t | 4 +- slarnML/test/riscv64_instr_test.t | 338 ++++++++--------------------- 7 files changed, 140 insertions(+), 284 deletions(-) diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 7fe3f9f21..40c8abb36 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -82,7 +82,8 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = | 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 :: fun_ids) args (id :: stack) (lvl + 1) |> f2 + let funs = if List.length args = 0 then fun_ids else id :: fun_ids in + res |> f1 |> update_env_fun id stack lvl |> lifting e1 funs args (id :: stack) (lvl + 1) |> f2 in match cc_ast with | CId id -> res |> find_name g_args fun_ids id >>= fun ast -> update_ast (fun _ -> Result ast) res @@ -121,6 +122,7 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = 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 + let e2_funs = if List.length (get_args d) = 0 then fun_ids else id :: fun_ids in res |> init_func d e1 |> fun r1 -> @@ -128,7 +130,7 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = |> get_ast >>= fun a1 -> (if List.length (get_args d) = 0 then r1 else r1 |> insert_let (get_fun_let (get_decl d) a1)) - |> lifting e2 (id::fun_ids) g_args stack lvl + |> lifting e2 e2_funs g_args stack lvl |> update_ast (fun a2 -> Result (LIn (id, a1, a2))) |> filter lvl | CFun (args, e) -> @@ -172,8 +174,8 @@ let rec unwrap_app expr = match expr with | LApp (id, args) -> (match args with | [] -> expr - | [arg] -> LApp (id, [unwrap_app arg]) - | fst :: args -> List.fold_left (fun app arg -> LApp (app, [unwrap_app arg])) (LApp (id, [unwrap_app fst])) args) + | [arg] -> LApp (unwrap_app id, [unwrap_app arg]) + | fst :: args -> List.fold_left (fun app arg -> LApp (app, [unwrap_app arg])) (LApp (unwrap_app id, [unwrap_app fst])) args) | LId _ | LConst _ -> expr | LNot (e) -> LNot (unwrap_app e) | LOr (e1, e2) -> LOr (unwrap_app e1, unwrap_app e2) diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index 4d5caf86a..8daa66542 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -91,12 +91,17 @@ struct Func copy_func(const struct Func *original) { copy.cif = malloc(sizeof(ffi_cif)); if (!copy.cif) { fprintf(stderr, "Memory allocation failed for cif!\n"); + free(copy.argsfun); + exit(1); } memcpy(copy.cif, original->cif, sizeof(ffi_cif)); copy.arg_types = malloc(sizeof(ffi_type*) * (original->argscnt + 1)); if (!copy.arg_types) { fprintf(stderr, "Memory allocation failed for arg_types!\n"); + free(copy.argsfun); + free(copy.cif); + exit(1); } for (int i = 0; i < original->argscnt; i++) { copy.arg_types[i] = original->arg_types[i]; @@ -106,6 +111,10 @@ struct Func copy_func(const struct Func *original) { copy.arg_values = malloc(sizeof(void*) * original->argscnt); if (!copy.arg_values) { fprintf(stderr, "Memory allocation failed for arg_values!\n"); + free(copy.argsfun); + free(copy.cif); + free(copy.arg_types); + exit(1); } memcpy(copy.arg_values, original->arg_values, sizeof(void*) * original->argscnt); @@ -142,6 +151,13 @@ int64_t app_n(struct Func *f) { } int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { + fprintf(stdout, "Warning: %p(%ld) [%d %d]", f->ptr, (int64_t)f, f->argscnt, f->cnt); + if (cnt > 0) { + fprintf(stdout, " -> %ld\n", args[0]); + } else { + fprintf(stdout, "\n"); + } + if (f == NULL || args == NULL) { fprintf(stderr, "Error: NULL pointer in app function\n"); return -1; @@ -160,6 +176,7 @@ int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { int64_t ret = app_n(f); if (new_cnt > f->argscnt) { + fprintf(stdout, "Warning: overflow args\n"); int64_t new_args[MAX_ARGS]; for (int i = 0; i < new_cnt - f->argscnt && i < MAX_ARGS; i++) { new_args[i] = args[i + (f->argscnt - f_cnt)]; @@ -195,10 +212,10 @@ int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { int app_idx = 0; if ((int64_t)&part_apps[0] <= (int64_t)f_ptr && (int64_t)f_ptr <= (int64_t)&part_apps[MAX_APPS-1]) { - part_apps[last_app] = copy_func(f_ptr); - used_apps[last_app] = 1; - app_idx = last_app; - // app_idx = ((int64_t)f_ptr - (int64_t)&part_apps[0]) / sizeof(struct Func); + // part_apps[last_app] = copy_func(f_ptr); + // used_apps[last_app] = 1; + // app_idx = last_app; + app_idx = ((int64_t)f_ptr - (int64_t)&part_apps[0]) / sizeof(struct Func); } else { part_apps[last_app] = func_init(f_ptr, argcnt); used_apps[last_app] = 1; @@ -207,7 +224,9 @@ int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { last_app = (last_app + 1) % MAX_APPS; - return app(&part_apps[app_idx], appcnt, args); + int64_t ret = app(&part_apps[app_idx], appcnt, args); + fprintf(stdout, "Result: %ld\n", ret); + return ret; } void init_part_apps() { @@ -248,7 +267,7 @@ void cleanup_part_apps() { #include void print_int2(int number) { - printf("%d", number); + fprintf(stdout, "%d", number); } diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index e91d7d84d..7742e0e29 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -39,12 +39,11 @@ let f_id x = x let get_fun name = map (fun (_, _, _, _, _, funs) -> + (* print_endline ("get_fun " ^ name ^ " " ^ (String.concat ", " (List.map (fun (f_name, cnt) -> f_name^"("^string_of_int cnt^")") funs))); *) Result (List.find_opt (fun (f_name, _) -> - f_name = name - || (String.length f_name > String.length name - && String.sub f_name 0 (String.length name) = name)) + f_name = name) funs)) ;; @@ -615,7 +614,7 @@ let init_fun anf res = let args_cnt = List.length args in let res = res |> add_fun unique_id args_cnt in res - |> save_args (-offset_full) args + |> save_args (-offset_align) args >>= fun (s_argsi, env) -> Result ([], None, env) |> build_aexpr (Id "") e diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 70c4ee12e..1672ab4ef 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -515,31 +515,27 @@ in (let rez=anf_app#29 in - (let anf_app#30=(rez ) + (let anf_app#30=(print_int rez) in - (let anf_app#31=(print_int anf_app#30) + (let ()=anf_app#30 in - (let ()=anf_app#31 + (let anf_app#31=(test3 ) in - (let anf_app#32=(test3 ) + (let anf_app#32=(wrap anf_app#31) in - (let anf_app#33=(wrap anf_app#32) + (let anf_app#33=(anf_app#32 1) in - (let anf_app#34=(anf_app#33 1) + (let anf_app#34=(anf_app#33 10) in - (let anf_app#35=(anf_app#34 10) + (let anf_app#35=(anf_app#34 100) in - (let anf_app#36=(anf_app#35 100) + (let temp3=anf_app#35 in - (let temp3=anf_app#36 + (let anf_app#36=(print_int temp3) in - (let anf_app#37=(temp3 ) + (let ()=anf_app#36 in - (let anf_app#38=(print_int anf_app#37) - in - (let ()=anf_app#38 - in - 0))))))))))))))))))))))))) + 0))))))))))))))))))))))) ) $ dune exec anf_conv_test < manytests/typed/005fix.ml (fun fix(f x)-> @@ -666,13 +662,11 @@ in (let foo_0_2_4=anf_app#8 in - (let anf_app#9=(foo_0_2_4 ) - in - (let anf_app#10=(print_int anf_app#9) + (let anf_app#9=(print_int foo_0_2_4) in - (let ()=anf_app#10 + (let ()=anf_app#9 in - 0))))))))) + 0)))))))) ) $ dune exec anf_conv_test < manytests/typed/006partial3.ml (fun anon$2(b a c)-> diff --git a/slarnML/test/exec_test.t_ b/slarnML/test/exec_test.t_ index 4449e3f8a733b1e1647e66ab8fa4a954a48cba42..c9f1a97e84b2d1e56215e31c53369f5d528e1f33 100644 GIT binary patch delta 120 zcmaE*_*rp-Guvcy7Q4+0*{(4%8c)_?vfaFu<1(X$p&0_Mpd7_B9t8X1hBI*g&TIoR-jd~X;5WXu>t delta 134 zcmeyY_)2kuGn+Kn420+He|BcJeA`zBPk}>ZNA2}fSFNw@_R;`%~$y3nE+v6E(ibs diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index e868e6123..d42c4ead3 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -60,7 +60,7 @@ (fun c_0(a b c)->({print_int c})) (fun test3(a b c)->(let a_0 = ({print_int a} in let b_0 = ({print_int b} in let c_0 = ({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 main()->(let rez = ({{{{{{{{{{{wrap {test10 }} 1} 10} 100} 1000} 10000} 100000} 1000000} 10000000} 100000000} 1000000000} in let () = ({print_int {rez }} in let temp3 = ({{{{wrap {test3 }} 1} 10} 100} in let () = ({print_int {temp3 }} 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 temp3 = ({{{{wrap {test3 }} 1} 10} 100} in let () = ({print_int temp3} 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)})))) @@ -73,7 +73,7 @@ (fun main()->(let () = ({print_int {foo_0 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 main()->(let foo_0 = ({foo 1} in let foo_0_2 = ({foo_0 2} in let foo_0_2_4 = ({foo_0_2 3} in let () = ({print_int {foo_0_2_4 }} in 0)))))) + (fun main()->(let foo_0 = ({foo 1} in let foo_0_2 = ({foo_0 2} in let foo_0_2_4 = ({foo_0_2 3} in let () = ({print_int foo_0_2_4} in 0)))))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml (fun anon$2(b a c)->({print_int c})) (fun anon$1(a b)->(let () = ({print_int b} in {{anon$2 b} a}))) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index 100040cdf..f23fcc172 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -36,7 +36,7 @@ sd ra,80(sp) sd s0,72(sp) addi s0,sp,96 - sd a0,-88(s0) + sd a0,-96(s0) li t0,1 blt a0,t0,.tag_anf_op_1 li t1,1 @@ -48,7 +48,7 @@ li a2,1 li a1,1 call part_app - ld t2,-88(s0) + ld t2,-96(s0) mul t1,t2,a0 sd a0,-40(s0) mv a0,t1 @@ -156,149 +156,7 @@ $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml Id f not found in env - .attribute unaligned_access, 0 - .attribute stack_align, 16 - .global main - main: - addi sp,sp,-32 - sd ra,16(sp) - sd s0,8(sp) - sd s1,0(sp) - addi s0,sp,32 - call init_part_apps - call main2 - sd a0,24(sp) - call cleanup_part_apps - ld a0,24(sp) - ld ra,16(sp) - ld s0,8(sp) - ld s1,0(sp) - addi sp,sp,32 - li a7,93 - ecall - anon_2: - addi sp,sp,-96 - sd ra,88(sp) - sd s0,80(sp) - addi s0,sp,96 - sd a1,-96(s0) - sd a0,-88(s0) - ld a0,-88(s0) - mv a3,a0 - li a2,1 - li a1,0 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - ld a3,-96(s0) - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,88(sp) - ld s0,80(sp) - addi sp,sp,96 - ret - anon_1: - addi sp,sp,-128 - sd ra,120(sp) - sd s0,112(sp) - addi s0,sp,128 - sd a1,-128(s0) - sd a0,-120(s0) - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - ld a3,-128(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - ld a3,-120(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-120(s0) - ld a3,-40(s0) - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,120(sp) - ld s0,112(sp) - addi sp,sp,128 - ret - fix: - 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) - addi a0,a0,%lo(anon_1) - ld a3,-56(s0) - li a2,1 - li a1,2 - call part_app - mv a0,a0 - ld ra,48(sp) - ld s0,40(sp) - addi sp,sp,64 - ret - anon_4: - addi sp,sp,-96 - sd ra,88(sp) - sd s0,80(sp) - addi s0,sp,96 - sd a1,-96(s0) - sd a0,-88(s0) - ld a0,-88(s0) - mv a3,a0 - li a2,1 - li a1,0 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - ld a3,-96(s0) - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,88(sp) - ld s0,80(sp) - addi sp,sp,96 - ret - anon_3: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - sd a0,-120(s0) - lui a0,%hi(f) - addi a0,a0,%lo(f) - ld a3,-120(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-32(s0) - lui a0,%hi(anon_4) - addi a0,a0,%lo(anon_4) - ld a3,-120(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-40(s0) - ld a0,-32(s0) - ld a3,-40(s0) - li a2,1 - li a1,0 - call part_app - mv a0,a0 - ld ra,112(sp) - ld s0,104(sp) - addi sp,sp,128 - ret + f not found $ dune exec riscv64_instr_test < manytests/typed/001fac.ml .attribute unaligned_access, 0 @@ -326,7 +184,7 @@ sd ra,80(sp) sd s0,72(sp) addi s0,sp,96 - sd a0,-88(s0) + sd a0,-96(s0) li t0,1 ble a0,t0,.tag_anf_op_1 li t1,1 @@ -338,7 +196,7 @@ li a2,1 li a1,1 call part_app - ld t2,-88(s0) + ld t2,-96(s0) mul t1,t2,a0 sd a0,-40(s0) mv a0,t1 @@ -423,8 +281,8 @@ sd ra,208(sp) sd s0,200(sp) addi s0,sp,224 - sd a1,-216(s0) - sd a0,-208(s0) + sd a1,-224(s0) + sd a0,-216(s0) li t0,1 beq a0,t0,.tag_anf_op_3 li t1,1 @@ -439,13 +297,13 @@ sd a0,-40(s0) lui a0,%hi(anon_1) addi a0,a0,%lo(anon_1) - ld a3,-208(s0) + ld a3,-216(s0) li a2,1 li a1,3 call part_app sd a0,-48(s0) ld a0,-48(s0) - ld a3,-216(s0) + ld a3,-224(s0) li a2,1 li a1,0 call part_app @@ -458,7 +316,7 @@ j .tag_anf_op_3_t .tag_anf_op_3: sd a0,-64(s0) - ld a0,-216(s0) + ld a0,-224(s0) li a3,1 li a2,1 li a1,0 @@ -475,7 +333,7 @@ sd ra,16(sp) sd s0,8(sp) addi s0,sp,32 - sd a0,-24(s0) + sd a0,-32(s0) mv a0,a0 ld ra,16(sp) ld s0,8(sp) @@ -574,9 +432,9 @@ sd ra,368(sp) sd s0,360(sp) addi s0,sp,384 - sd a2,-376(s0) - sd a1,-368(s0) - sd a0,-360(s0) + sd a2,-384(s0) + sd a1,-376(s0) + sd a0,-368(s0) li t0,1 beq a2,t0,.tag_anf_op_3 li t1,1 @@ -588,26 +446,26 @@ sd t3,-56(s0) lui a0,%hi(fib_acc) addi a0,a0,%lo(fib_acc) - ld a3,-368(s0) + ld a3,-376(s0) li a2,1 li a1,3 call part_app sd a0,-64(s0) lui a0,%hi(ab) addi a0,a0,%lo(ab) - ld a3,-360(s0) + ld a3,-368(s0) li a2,1 li a1,3 call part_app sd a0,-72(s0) ld a0,-72(s0) - ld a3,-368(s0) + ld a3,-376(s0) li a2,1 li a1,0 call part_app sd a0,-80(s0) ld a0,-80(s0) - ld a3,-376(s0) + ld a3,-384(s0) li a2,1 li a1,0 call part_app @@ -620,19 +478,19 @@ sd a0,-96(s0) lui a0,%hi(n1) addi a0,a0,%lo(n1) - ld a3,-360(s0) + ld a3,-368(s0) li a2,1 li a1,3 call part_app sd a0,-104(s0) ld a0,-104(s0) - ld a3,-368(s0) + ld a3,-376(s0) li a2,1 li a1,0 call part_app sd a0,-112(s0) ld a0,-112(s0) - ld a3,-376(s0) + ld a3,-384(s0) li a2,1 li a1,0 call part_app @@ -644,7 +502,7 @@ call part_app j .tag_anf_op_3_t .tag_anf_op_3: - ld t3,-368(s0) + ld t3,-376(s0) sd a0,-128(s0) mv a0,t3 .tag_anf_op_3_t: @@ -730,7 +588,7 @@ addi a0,a0,%lo(fib) li a3,4 li a2,1 - li a1,3 + li a1,1 call part_app sd a0,-72(s0) lui a0,%hi(print_int) @@ -773,7 +631,7 @@ sd ra,32(sp) sd s0,24(sp) addi s0,sp,48 - sd a0,-40(s0) + sd a0,-48(s0) li t0,1 li t1,1 beq t0,t1,.tag_anf_op_1 @@ -790,12 +648,12 @@ sd ra,64(sp) sd s0,56(sp) addi s0,sp,80 - sd a2,-72(s0) - sd a1,-64(s0) - sd a0,-56(s0) + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-56(s0) + ld a3,-64(s0) li a2,1 li a1,1 call part_app @@ -809,12 +667,12 @@ sd ra,64(sp) sd s0,56(sp) addi s0,sp,80 - sd a2,-72(s0) - sd a1,-64(s0) - sd a0,-56(s0) + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-64(s0) + ld a3,-72(s0) li a2,1 li a1,1 call part_app @@ -828,12 +686,12 @@ sd ra,64(sp) sd s0,56(sp) addi s0,sp,80 - sd a2,-72(s0) - sd a1,-64(s0) - sd a0,-56(s0) + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-72(s0) + ld a3,-80(s0) li a2,1 li a1,1 call part_app @@ -884,14 +742,14 @@ sd ra,144(sp) sd s0,136(sp) addi s0,sp,160 - sd a7,-152(s0) - sd a6,-144(s0) - sd a5,-136(s0) - sd a4,-128(s0) - sd a3,-120(s0) - sd a2,-112(s0) - sd a1,-104(s0) - sd a0,-96(s0) + sd a7,-160(s0) + sd a6,-152(s0) + sd a5,-144(s0) + sd a4,-136(s0) + sd a3,-128(s0) + sd a2,-120(s0) + sd a1,-112(s0) + sd a0,-104(s0) add t0,a0,a1 add t1,t0,a2 add t2,t1,a3 @@ -909,10 +767,10 @@ addi sp,sp,160 ret main2: - addi sp,sp,-720 - sd ra,712(sp) - sd s0,704(sp) - addi s0,sp,720 + addi sp,sp,-656 + sd ra,648(sp) + sd s0,640(sp) + addi s0,sp,656 lui a0,%hi(test10) addi a0,a0,%lo(test10) li a2,0 @@ -987,68 +845,58 @@ call part_app sd a0,-120(s0) sd a0,-128(s0) - ld a0,-128(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-136(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-136(s0) + ld a3,-128(s0) li a2,1 li a1,1 call part_app + sd a0,-136(s0) sd a0,-144(s0) - sd a0,-152(s0) lui a0,%hi(test3) addi a0,a0,%lo(test3) li a2,0 li a1,3 call part_app - sd a0,-160(s0) + sd a0,-152(s0) lui a0,%hi(wrap) addi a0,a0,%lo(wrap) - ld a3,-160(s0) + ld a3,-152(s0) li a2,1 li a1,1 call part_app - sd a0,-168(s0) - ld a0,-168(s0) + sd a0,-160(s0) + ld a0,-160(s0) li a3,1 li a2,1 li a1,0 call part_app - sd a0,-176(s0) - ld a0,-176(s0) + sd a0,-168(s0) + ld a0,-168(s0) li a3,10 li a2,1 li a1,0 call part_app - sd a0,-184(s0) - ld a0,-184(s0) + sd a0,-176(s0) + ld a0,-176(s0) li a3,100 li a2,1 li a1,0 call part_app + sd a0,-184(s0) sd a0,-192(s0) - sd a0,-200(s0) - ld a0,-200(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-208(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-208(s0) + ld a3,-192(s0) li a2,1 li a1,1 call part_app - sd a0,-216(s0) + sd a0,-200(s0) li t0,0 mv a0,t0 - ld ra,712(sp) - ld s0,704(sp) - addi sp,sp,720 + ld ra,648(sp) + ld s0,640(sp) + addi sp,sp,656 ret $ dune exec riscv64_instr_test < manytests/typed/005fix.ml @@ -1086,11 +934,10 @@ li a1,2 call part_app sd a0,-32(s0) - lui a0,%hi(f) - addi a0,a0,%lo(f) + ld a0,-120(s0) ld a3,-32(s0) li a2,1 - li a1,2 + li a1,0 call part_app sd a0,-40(s0) ld a0,-40(s0) @@ -1197,8 +1044,8 @@ sd ra,32(sp) sd s0,24(sp) addi s0,sp,48 - sd a1,-40(s0) - sd a0,-32(s0) + sd a1,-48(s0) + sd a0,-40(s0) li t0,2 add t1,a1,t0 mv a0,t1 @@ -1211,8 +1058,8 @@ sd ra,32(sp) sd s0,24(sp) addi s0,sp,48 - sd a1,-40(s0) - sd a0,-32(s0) + sd a1,-48(s0) + sd a0,-40(s0) li t0,10 mul t1,a1,t0 mv a0,t1 @@ -1254,7 +1101,7 @@ sd ra,272(sp) sd s0,264(sp) addi s0,sp,288 - sd a0,-280(s0) + sd a0,-288(s0) lui a0,%hi(foo) addi a0,a0,%lo(foo) li a3,1 @@ -1284,7 +1131,7 @@ call part_app sd a0,-56(s0) ld a0,-56(s0) - ld a3,-280(s0) + ld a3,-288(s0) li a2,1 li a1,0 call part_app @@ -1399,10 +1246,10 @@ addi sp,sp,176 ret main2: - addi sp,sp,-208 - sd ra,200(sp) - sd s0,192(sp) - addi s0,sp,208 + addi sp,sp,-176 + sd ra,168(sp) + sd s0,160(sp) + addi s0,sp,176 lui a0,%hi(foo) addi a0,a0,%lo(foo) li a3,1 @@ -1425,23 +1272,18 @@ call part_app sd a0,-64(s0) sd a0,-72(s0) - ld a0,-72(s0) - li a2,0 - li a1,0 - call part_app - sd a0,-80(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-80(s0) + ld a3,-72(s0) li a2,1 li a1,1 call part_app - sd a0,-88(s0) + sd a0,-80(s0) li t0,0 mv a0,t0 - ld ra,200(sp) - ld s0,192(sp) - addi sp,sp,208 + ld ra,168(sp) + ld s0,160(sp) + addi sp,sp,176 ret $ dune exec riscv64_instr_test < manytests/typed/006partial3.ml @@ -1470,12 +1312,12 @@ sd ra,64(sp) sd s0,56(sp) addi s0,sp,80 - sd a2,-72(s0) - sd a1,-64(s0) - sd a0,-56(s0) + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-72(s0) + ld a3,-80(s0) li a2,1 li a1,1 call part_app @@ -1489,11 +1331,11 @@ sd ra,128(sp) sd s0,120(sp) addi s0,sp,144 - sd a1,-136(s0) - sd a0,-128(s0) + sd a1,-144(s0) + sd a0,-136(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-136(s0) + ld a3,-144(s0) li a2,1 li a1,1 call part_app @@ -1501,13 +1343,13 @@ sd a0,-40(s0) lui a0,%hi(anon_2) addi a0,a0,%lo(anon_2) - ld a3,-136(s0) + ld a3,-144(s0) li a2,1 li a1,3 call part_app sd a0,-48(s0) ld a0,-48(s0) - ld a3,-128(s0) + ld a3,-136(s0) li a2,1 li a1,0 call part_app From 33784ef7cc4a283d1b00959dd116ee0cd2e98780 Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 14 Apr 2025 10:41:10 +0300 Subject: [PATCH 33/45] Format --- slarnML/lib/anf/anf_conv.ml | 24 ++-- slarnML/lib/anf/clos_conv.ml | 231 ++++++++++++++++++++---------- slarnML/lib/anf/lambda_lifting.ml | 65 ++++++--- slarnML/lib/riscv64/riscv.ml | 6 +- 4 files changed, 216 insertions(+), 110 deletions(-) diff --git a/slarnML/lib/anf/anf_conv.ml b/slarnML/lib/anf/anf_conv.ml index a93a53faa..6eeb1071c 100644 --- a/slarnML/lib/anf/anf_conv.ml +++ b/slarnML/lib/anf/anf_conv.ml @@ -60,20 +60,20 @@ let rec anf_expr e expr_with_hole = ALet (name, AIf (cimm, t_anf, f_anf), expr_with_hole (AId name))) | LApp (func, arg :: args) -> anf_expr func (fun func_imm -> - 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 (func_imm, List.rev (imm :: lst)), expr_with_hole (AId name))) - args) - [] - imm_arg)) + 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 (func_imm, List.rev (imm :: lst)), expr_with_hole (AId name))) + args) + [] + imm_arg)) | LApp (func, []) -> anf_expr func (fun func_imm -> - let name = get_name "anf_app" in - ALet (name, AApp (func_imm, []), expr_with_hole (AId name))) + let name = get_name "anf_app" in + ALet (name, AApp (func_imm, []), expr_with_hole (AId name))) | LIn (id, e1, e2) -> anf_expr e1 (fun limm -> (* let name = "anf_" ^ get_name id in *) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 345a78ab0..340678c26 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -6,76 +6,153 @@ open Cc_ast open Res -let default_fun = List.map (fun (id, _) -> (id, id, 0, [])) Call_define.default_func -let remove_args id args prt_args = if id = "()" then [] else List.filter (fun x -> not (List.mem x args)) prt_args -;; - -let get_new_name id cnt = if id = "()" then id else id^"_"^(string_of_int cnt);; +let default_fun = List.map (fun (id, _) -> id, id, 0, []) Call_define.default_func -let rec closure_conversion ?(env=[]) ?(prt_args=[]) = function -| Ast.Id id -> (match List.find_opt (fun (name, _, _, _) -> name = id) env with - | None -> print_string ("Id "^id^" not found in env\n"); CId id - | Some (_, new_name, _, args) -> if List.length args > 0 then CApp (CId new_name, List.map (fun arg -> CId arg) args) else CId new_name) -| Ast.Const const -> CConst const -| Ast.Not e -> CNot (closure_conversion ~env ~prt_args e) -| Ast.Or (e1, e2) -> COr (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.And (e1, e2) -> CAnd (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Eq (e1, e2) -> CEq (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Gt (e1, e2) -> CGt (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Lt (e1, e2) -> CLt (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Gte (e1, e2) -> CGte (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Lte (e1, e2) -> CLte (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Add (e1, e2) -> CAdd (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Sub (e1, e2) -> CSub (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Mul (e1, e2) -> CMul (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.Div (e1, e2) -> CDiv (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) -| Ast.If (cond, then_expr, else_expr) -> - CIf (closure_conversion ~env ~prt_args cond, closure_conversion ~env ~prt_args then_expr, closure_conversion ~env ~prt_args else_expr) -| Ast.Let (decl, body) -> - let id, args, declared, pre_env = (match decl with - | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun _ _ -> []) - | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun new_name cnt -> [(id, new_name, cnt+1, (remove_args id args prt_args))])) - in - let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in - (match List.find_opt (fun (name, _, _, _) -> name = id) env with - | None -> CLet (declared id args, closure_conversion ~env:((pre_env id 0) @env_args) ~prt_args:(args@prt_args) body) - | Some (_, old_name, cnt, _) -> - let new_name = get_new_name old_name cnt in - let body_converted = closure_conversion ~env:((pre_env new_name cnt) @env_args) ~prt_args:(args@prt_args) body in - CLet (declared new_name args, body_converted)) -| Ast.LetIn (decl, expr1, expr2) -> - let id, args, declared, pre_env = (match decl with - | Ast.Decl (id, args) -> id, args, (fun id args -> Ast.Decl (id, (remove_args id args prt_args)@args)), (fun _ _ -> []) - | Ast.DeclRec (id, args) -> id, args, (fun id args -> Ast.DeclRec (id, (remove_args id args prt_args)@args)), (fun new_name cnt -> [(id, new_name, cnt + 1, (remove_args id args prt_args))])) - in - let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in - (match List.find_opt (fun (name, _, _, _) -> name = id) env with - | None -> - let decl_converted = closure_conversion ~env:((pre_env id 0) @env_args) ~prt_args:(args@prt_args) expr1 in - let expr2_converted = closure_conversion ~env:((id, id, 0, (remove_args id args prt_args)) :: env) ~prt_args expr2 in - CLetIn (declared id args, decl_converted, expr2_converted) - | Some (_, old_name, cnt, _) -> - let new_name = get_new_name old_name cnt in - let decl_converted = closure_conversion ~env:((pre_env new_name cnt) @env_args) ~prt_args:(args@prt_args) expr1 in - let expr2_converted = closure_conversion ~env:((id, new_name, cnt + 2, (remove_args id args prt_args)) :: env) ~prt_args expr2 in - CLetIn (declared new_name args, decl_converted, expr2_converted)) -| Ast.Fun (args, body) -> - let env_args = (List.map (fun arg -> (arg, arg, 0, [])) args) @ env in - let body_converted = closure_conversion ~env:env_args ~prt_args:(args @ prt_args) body in - CApp (CFun (((remove_args "" args prt_args)@args), body_converted), List.map (fun arg -> CId arg) prt_args) -| Ast.App (func, args) -> - let func_converted = closure_conversion ~env ~prt_args func in - let args_converted = List.map (closure_conversion ~env ~prt_args) args in - let prt_args = List.map (fun arg -> CId arg) (match func with - | Ast.Id id -> (match List.find_opt (fun (name, _, _, _) -> name = id) env with - | None -> prt_args - | Some (_, _, _, args) -> args) - | _ -> prt_args) - in - CApp (func_converted, prt_args@args_converted) +let remove_args id args prt_args = + if id = "()" then [] else List.filter (fun x -> not (List.mem x args)) prt_args ;; +let get_new_name id cnt = if id = "()" then id else id ^ "_" ^ string_of_int cnt +let rec closure_conversion ?(env = []) ?(prt_args = []) = function + | Ast.Id id -> + (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> + print_string ("Id " ^ id ^ " not found in env\n"); + CId id + | Some (_, new_name, _, args) -> + if List.length args > 0 + then CApp (CId new_name, List.map (fun arg -> CId arg) args) + else CId new_name) + | Ast.Const const -> CConst const + | Ast.Not e -> CNot (closure_conversion ~env ~prt_args e) + | Ast.Or (e1, e2) -> + COr (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.And (e1, e2) -> + CAnd (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Eq (e1, e2) -> + CEq (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Gt (e1, e2) -> + CGt (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Lt (e1, e2) -> + CLt (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Gte (e1, e2) -> + CGte (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Lte (e1, e2) -> + CLte (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Add (e1, e2) -> + CAdd (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Sub (e1, e2) -> + CSub (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Mul (e1, e2) -> + CMul (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.Div (e1, e2) -> + CDiv (closure_conversion ~env ~prt_args e1, closure_conversion ~env ~prt_args e2) + | Ast.If (cond, then_expr, else_expr) -> + CIf + ( closure_conversion ~env ~prt_args cond + , closure_conversion ~env ~prt_args then_expr + , closure_conversion ~env ~prt_args else_expr ) + | Ast.Let (decl, body) -> + let id, args, declared, pre_env = + match decl with + | Ast.Decl (id, args) -> + ( id + , args + , (fun id args -> Ast.Decl (id, remove_args id args prt_args @ args)) + , fun _ _ -> [] ) + | Ast.DeclRec (id, args) -> + ( id + , args + , (fun id args -> Ast.DeclRec (id, remove_args id args prt_args @ args)) + , fun new_name cnt -> [ id, new_name, cnt + 1, remove_args id args prt_args ] ) + in + let env_args = List.map (fun arg -> arg, arg, 0, []) args @ env in + (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> + CLet + ( declared id args + , closure_conversion + ~env:(pre_env id 0 @ env_args) + ~prt_args:(args @ prt_args) + body ) + | Some (_, old_name, cnt, _) -> + let new_name = get_new_name old_name cnt in + let body_converted = + closure_conversion + ~env:(pre_env new_name cnt @ env_args) + ~prt_args:(args @ prt_args) + body + in + CLet (declared new_name args, body_converted)) + | Ast.LetIn (decl, expr1, expr2) -> + let id, args, declared, pre_env = + match decl with + | Ast.Decl (id, args) -> + ( id + , args + , (fun id args -> Ast.Decl (id, remove_args id args prt_args @ args)) + , fun _ _ -> [] ) + | Ast.DeclRec (id, args) -> + ( id + , args + , (fun id args -> Ast.DeclRec (id, remove_args id args prt_args @ args)) + , fun new_name cnt -> [ id, new_name, cnt + 1, remove_args id args prt_args ] ) + in + let env_args = List.map (fun arg -> arg, arg, 0, []) args @ env in + (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> + let decl_converted = + closure_conversion + ~env:(pre_env id 0 @ env_args) + ~prt_args:(args @ prt_args) + expr1 + in + let expr2_converted = + closure_conversion + ~env:((id, id, 0, remove_args id args prt_args) :: env) + ~prt_args + expr2 + in + CLetIn (declared id args, decl_converted, expr2_converted) + | Some (_, old_name, cnt, _) -> + let new_name = get_new_name old_name cnt in + let decl_converted = + closure_conversion + ~env:(pre_env new_name cnt @ env_args) + ~prt_args:(args @ prt_args) + expr1 + in + let expr2_converted = + closure_conversion + ~env:((id, new_name, cnt + 2, remove_args id args prt_args) :: env) + ~prt_args + expr2 + in + CLetIn (declared new_name args, decl_converted, expr2_converted)) + | Ast.Fun (args, body) -> + let env_args = List.map (fun arg -> arg, arg, 0, []) args @ env in + let body_converted = + closure_conversion ~env:env_args ~prt_args:(args @ prt_args) body + in + CApp + ( CFun (remove_args "" args prt_args @ args, body_converted) + , List.map (fun arg -> CId arg) prt_args ) + | Ast.App (func, args) -> + let func_converted = closure_conversion ~env ~prt_args func in + let args_converted = List.map (closure_conversion ~env ~prt_args) args in + let prt_args = + List.map + (fun arg -> CId arg) + (match func with + | Ast.Id id -> + (match List.find_opt (fun (name, _, _, _) -> name = id) env with + | None -> prt_args + | Some (_, _, _, args) -> args) + | _ -> prt_args) + in + CApp (func_converted, prt_args @ args_converted) +;; let clos_conv ast = List.fold_left @@ -83,16 +160,20 @@ let clos_conv ast = cc_ast >>= fun (cc_ast, funs) -> let c_ast = closure_conversion ~env:funs ast in - let new_funs = match c_ast with - | CLet (d, _) | CLetIn (d, _, _) -> - (match d with | Ast.Decl (new_name, _) | Ast.DeclRec (new_name, _) -> - (match ast with - | Ast.Let (d, _) | Ast.LetIn (d, _, _) -> - (match d with | Ast.Decl (old_name, _) | Ast.DeclRec (old_name, _) -> (old_name, new_name, 0, []) :: funs) - | _ -> (new_name, new_name, 0, []) :: funs)) - | _ -> funs + let new_funs = + match c_ast with + | CLet (d, _) | CLetIn (d, _, _) -> + (match d with + | Ast.Decl (new_name, _) | Ast.DeclRec (new_name, _) -> + (match ast with + | Ast.Let (d, _) | Ast.LetIn (d, _, _) -> + (match d with + | Ast.Decl (old_name, _) | Ast.DeclRec (old_name, _) -> + (old_name, new_name, 0, []) :: funs) + | _ -> (new_name, new_name, 0, []) :: funs)) + | _ -> funs in - Result (cc_ast @ [c_ast], new_funs)) + Result (cc_ast @ [ c_ast ], new_funs)) (Result ([], default_fun)) ast >>= fun (ast, _) -> Result ast diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 40c8abb36..50d7e563c 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -21,7 +21,10 @@ let find_name args fun_ids id = (* print_endline ("find_name " ^ id ^ " " ^ String.concat ", " fun_ids); *) match List.find_opt (fun (_, name, _) -> name = id) env with | None -> if List.mem id fun_ids then Result (LApp (LId id, [])) else Result (LId id) - | Some (_, _, new_name) -> if (List.mem id fun_ids && not (List.mem new_name args)) then Result (LApp (LId new_name, [])) else Result (LId new_name)) + | Some (_, _, new_name) -> + if List.mem id fun_ids && not (List.mem new_name args) + then Result (LApp (LId new_name, [])) + else Result (LId new_name)) ;; let insert_let a = map (fun (ast, lst, env, num) -> Result (ast, a :: lst, env, num)) @@ -58,7 +61,8 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = |> fun r1 -> r1 |> get_ast - >>= fun a1 -> r1 |> lifting e2 fun_ids g_args stack lvl |> update_ast (fun a2 -> Result (f a1 a2)) + >>= fun a1 -> + r1 |> lifting e2 fun_ids g_args stack lvl |> update_ast (fun a2 -> Result (f a1 a2)) in let get_id = function | Ast.Decl (id, _) | Ast.DeclRec (id, _) -> id @@ -76,17 +80,22 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = in let init_func d e1 res = let id = get_id d in - let args = (get_args d) @ g_args in + let args = get_args d @ g_args 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 let funs = if List.length args = 0 then fun_ids else id :: fun_ids in - res |> f1 |> update_env_fun id stack lvl |> lifting e1 funs args (id :: stack) (lvl + 1) |> f2 + res + |> f1 + |> update_env_fun id stack lvl + |> lifting e1 funs args (id :: stack) (lvl + 1) + |> f2 in match cc_ast with - | CId id -> res |> find_name g_args fun_ids id >>= fun ast -> update_ast (fun _ -> Result ast) res + | CId id -> + res |> find_name g_args fun_ids id >>= fun ast -> update_ast (fun _ -> Result ast) res | CConst c -> update_ast (fun _ -> Result (LConst c)) res | CNot e -> res |> lifting e fun_ids g_args stack lvl | COr (e1, e2) -> lifting_bin_op (fun a1 a2 -> LOr (a1, a2)) e1 e2 @@ -113,7 +122,9 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = r2 |> get_ast >>= fun a2 -> - r2 |> lifting e3 fun_ids g_args stack lvl |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) + r2 + |> lifting e3 fun_ids g_args stack lvl + |> update_ast (fun a3 -> Result (LIf (a1, a2, a3))) | CLet (d, e) -> (* let id = get_id d in *) res @@ -129,7 +140,9 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = r1 |> get_ast >>= fun a1 -> - (if List.length (get_args d) = 0 then r1 else r1 |> insert_let (get_fun_let (get_decl d) a1)) + (if List.length (get_args d) = 0 + then r1 + else r1 |> insert_let (get_fun_let (get_decl d) a1)) |> lifting e2 e2_funs g_args stack lvl |> update_ast (fun a2 -> Result (LIn (id, a1, a2))) |> filter lvl @@ -172,12 +185,17 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = let rec unwrap_app expr = match expr with - | LApp (id, args) -> (match args with - | [] -> expr - | [arg] -> LApp (unwrap_app id, [unwrap_app arg]) - | fst :: args -> List.fold_left (fun app arg -> LApp (app, [unwrap_app arg])) (LApp (unwrap_app id, [unwrap_app fst])) args) + | LApp (id, args) -> + (match args with + | [] -> expr + | [ arg ] -> LApp (unwrap_app id, [ unwrap_app arg ]) + | fst :: args -> + List.fold_left + (fun app arg -> LApp (app, [ unwrap_app arg ])) + (LApp (unwrap_app id, [ unwrap_app fst ])) + args) | LId _ | LConst _ -> expr - | LNot (e) -> LNot (unwrap_app e) + | LNot e -> LNot (unwrap_app e) | LOr (e1, e2) -> LOr (unwrap_app e1, unwrap_app e2) | LAnd (e1, e2) -> LAnd (unwrap_app e1, unwrap_app e2) | LEq (e1, e2) -> LEq (unwrap_app e1, unwrap_app e2) @@ -200,7 +218,13 @@ let lambda_lifting cc_ast = (fun prev_res ast -> prev_res >>= fun (anon_num, ll_ast) -> - let funs = List.map (fun e -> match e with | LFun (id, _, _) -> id) ll_ast in + let funs = + List.map + (fun e -> + match e with + | LFun (id, _, _) -> id) + ll_ast + in lifting ast funs [] [] 0 (default_res anon_num) |> fun res -> res @@ -208,9 +232,14 @@ let lambda_lifting cc_ast = >>= fun num -> res |> get_prog >>= fun p -> Result (num, ll_ast @ List.rev p)) (Result (0, [])) cc_ast - >>= fun (_, ast) -> Result ast - >>= fun g_ast -> Result ( - List.fold_left (fun acc ast -> match ast with - | LFun (id, args, e) -> acc @ [(LFun (id, args, unwrap_app e))] - ) [] g_ast) + >>= fun (_, ast) -> + Result ast + >>= fun g_ast -> + Result + (List.fold_left + (fun acc ast -> + match ast with + | LFun (id, args, e) -> acc @ [ LFun (id, args, unwrap_app e) ]) + [] + g_ast) ;; diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index 7742e0e29..e1e08fefa 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -40,11 +40,7 @@ let f_id x = x let get_fun name = map (fun (_, _, _, _, _, funs) -> (* print_endline ("get_fun " ^ name ^ " " ^ (String.concat ", " (List.map (fun (f_name, cnt) -> f_name^"("^string_of_int cnt^")") funs))); *) - Result - (List.find_opt - (fun (f_name, _) -> - f_name = name) - funs)) + Result (List.find_opt (fun (f_name, _) -> f_name = name) funs)) ;; let get_funs = map (fun (_, _, _, _, _, funs) -> Result funs) From ed3ba190cd336af957310efa10ebee2810383763 Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 14 Apr 2025 17:51:13 +0300 Subject: [PATCH 34/45] Add tests for anf and format --- slarnML/lib/anf/clos_conv.ml | 6 +- slarnML/lib/anf/ll_ast.ml | 2 + slarnML/lib/dune | 4 +- slarnML/lib/inferencer/typedtree.ml | 2 + slarnML/lib/riscv64/riscv_ast.ml | 1 + slarnML/lib/test/anf_test.ml | 434 ++++++++++++++------- slarnML/test/anf_conv_test.t | 406 +++++++++++++++++-- slarnML/test/clos_conv_test.t | 54 ++- slarnML/test/{exec_test.t_ => exec_test.t} | Bin slarnML/test/lambda_lifting_test.t | 76 +++- slarnML/test/riscv64_instr_test.t | 140 +++++++ 11 files changed, 926 insertions(+), 199 deletions(-) rename slarnML/test/{exec_test.t_ => exec_test.t} (100%) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 340678c26..0b946d5e8 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -141,7 +141,7 @@ let rec closure_conversion ?(env = []) ?(prt_args = []) = function | Ast.App (func, args) -> let func_converted = closure_conversion ~env ~prt_args func in let args_converted = List.map (closure_conversion ~env ~prt_args) args in - let prt_args = + (* let prt_args = List.map (fun arg -> CId arg) (match func with @@ -150,8 +150,8 @@ let rec closure_conversion ?(env = []) ?(prt_args = []) = function | None -> prt_args | Some (_, _, _, args) -> args) | _ -> prt_args) - in - CApp (func_converted, prt_args @ args_converted) + in *) + CApp (func_converted, args_converted) ;; let clos_conv ast = diff --git a/slarnML/lib/anf/ll_ast.ml b/slarnML/lib/anf/ll_ast.ml index e69805a79..0cbf0568e 100644 --- a/slarnML/lib/anf/ll_ast.ml +++ b/slarnML/lib/anf/ll_ast.ml @@ -23,4 +23,6 @@ type l_expr = [@@deriving show { with_path = false }] type gl_expr = LFun of string * string list * l_expr (* declare function *) +[@@deriving show { with_path = false }] + type ll_ast = gl_expr list [@@deriving show { with_path = false }] diff --git a/slarnML/lib/dune b/slarnML/lib/dune index b1d2964e8..6f7ec6a2a 100644 --- a/slarnML/lib/dune +++ b/slarnML/lib/dune @@ -26,9 +26,9 @@ Riscv Pprint Quick_check_ast) - (libraries base angstrom) ; llvm) + (libraries base angstrom ppx_deriving) ; llvm) (preprocess - (pps ppx_expect ppx_inline_test)) + (pps ppx_deriving.show ppx_expect ppx_inline_test)) (inline_tests)) (include_subdirs unqualified) diff --git a/slarnML/lib/inferencer/typedtree.ml b/slarnML/lib/inferencer/typedtree.ml index 8e8aae544..10d246779 100644 --- a/slarnML/lib/inferencer/typedtree.ml +++ b/slarnML/lib/inferencer/typedtree.ml @@ -12,6 +12,7 @@ type constTy = | UnitTy | IntTy | BoolTy +[@@deriving show { with_path = false }] type ty = | PrimTy of constTy @@ -23,6 +24,7 @@ type undefinedType = | Type of ty | Key of binder | Undefined +[@@deriving show { with_path = false }] open Res diff --git a/slarnML/lib/riscv64/riscv_ast.ml b/slarnML/lib/riscv64/riscv_ast.ml index fd8823da5..c37a71427 100644 --- a/slarnML/lib/riscv64/riscv_ast.ml +++ b/slarnML/lib/riscv64/riscv_ast.ml @@ -33,6 +33,7 @@ type math_i = | Srl (* >> *) | Or (* | *) | Xor (* ^ *) +[@@deriving show { with_path = false }] type math_op = | I of math_i diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml index ab6662f94..e111a35ed 100644 --- a/slarnML/lib/test/anf_test.ml +++ b/slarnML/lib/test/anf_test.ml @@ -2,12 +2,13 @@ (** SPDX-License-Identifier: LGPL-2.1-or-later *) -(* open Res *) +open Res (*==============================*) (*======Closure conversion======*) (*==============================*) -(* open Ast + +open Ast open Cc_ast open Clos_conv open Pprint_cc @@ -52,11 +53,12 @@ let cc1 = ( DeclRec ("fack", [ "n"; "k" ]) , CIf ( CLte (CId "n", CConst (CInt 1)) - , CApp (CApp (CId "n", []), [ CSub (CId "n", CConst (CInt 1)) ]) + , 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"), []) ]) + ( CFun ([ "n"; "k"; "n"; "m" ], CMul (CId "k", CMul (CId "m", CId "n"))) + , [ CId "n"; CId "k"; CId "n" ] ) ) + , CApp + (CId "fack", [ CId "n"; CApp (CFun ([ "n"; "x" ], CId "x"), [ CId "n" ]) ]) ) ) ] ;; @@ -82,9 +84,9 @@ let cc2 = , CLetIn ( Decl ("g", [ "a"; "c"; "d" ]) , CLetIn - ( Decl ("h", [ "a"; "c"; "d"; "e" ]) + ( Decl ("h", [ "c"; "d"; "a"; "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 "h", [ CId "c"; CId "d"; CId "a" ]), [ CConst (CInt 4) ]) ) , CApp (CApp (CId "g", [ CId "a" ]), [ CConst (CInt 2); CConst (CInt 3) ]) ) ) ] @@ -109,18 +111,16 @@ let cc3 = [ CLet ( Decl ("f", [ "a"; "b" ]) , CLetIn - ( Decl ("g", [ "b"; "a"; "c" ]) + ( Decl ("g", [ "a"; "b"; "c" ]) , CLetIn - ( Decl ("h", [ "c"; "b"; "a" ]) + ( Decl ("h", [ "c"; "a"; "b" ]) , 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) ]) ) ) + ( [ "c"; "a"; "b"; "x" ] + , CMul (CId "x", CApp (CId "a", [ CMul (CId "c", CId "b") ])) ) + , [ CId "c"; CId "a"; CId "b" ] ) + , CApp (CApp (CId "h", [ CId "c"; CId "a"; CId "b" ]), [ CId "a" ]) ) + , CApp (CApp (CId "g", [ CId "a"; CId "b" ]), [ CConst (CInt 3) ]) ) ) ] ;; @@ -145,12 +145,12 @@ let cc4 = , CLetIn ( Decl ("g", [ "a"; "b" ]) , CLetIn - ( Decl ("h", [ "a"; "b"; "c" ]) + ( Decl ("h", [ "a"; "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" ]) - ) ) + , CApp + ( CApp (CId "h", [ CId "a"; CId "a" ]) + , [ CConst (CInt 2); CConst (CInt 3) ] ) ) + , CApp (CId "g", [ CAdd (CConst (CInt 1), CConst (CInt 0)); CId "a" ]) ) ) ] ;; @@ -204,13 +204,13 @@ let cc6 = [ CLet ( Decl ("f", [ "a" ]) , CLetIn - ( Decl ("g", []) - , CApp (CFun ([ "x" ], CId "x"), []) + ( Decl ("g", [ "a" ]) + , CApp (CFun ([ "a"; "x" ], CId "x"), [ CId "a" ]) , 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 "g", [ CId "a" ]), [ CId "a" ]) , CApp (CApp (CId "h", [ CId "a" ]), [ CId "a" ]) ) ) ) ) ] ;; @@ -245,16 +245,27 @@ let ll_ok n res expected = ;; let ll1 = - [ LFun ("anon$1", [ "k"; "n"; "m" ], LMul (LId "k", LMul (LId "m", LId "n"))) + [ LFun ("anon$1", [ "n"; "k"; "n"; "m" ], LMul (LId "k", LMul (LId "m", LId "n"))) ; LFun ( "fack" , [ "n"; "k" ] , LIf ( LLte (LId "n", LConst (CInt 1)) - , LApp ("n", [ LSub (LId "n", LConst (CInt 1)) ]) - , LApp ("anon$1", [ LApp ("k", []); LApp ("n", []) ]) ) ) - ; LFun ("anon$2", [ "x" ], LId "x") - ; LFun ("fac", [ "n" ], LApp ("fack", [ LApp ("n", []); LApp ("anon$2", []) ])) + , LApp (LId "n", [ LSub (LId "n", LConst (CInt 1)) ]) + , LApp (LApp (LApp (LId "anon$1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) ) ) + ; LFun ("anon$2", [ "n"; "x" ], LId "x") + ; LFun + ( "fac" + , [ "n" ] + , LIn + ( "fack" + , LIf + ( LLte (LId "n", LConst (CInt 1)) + , LApp (LId "n", [ LSub (LId "n", LConst (CInt 1)) ]) + , LApp (LApp (LApp (LId "anon$1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) + ) + , LApp (LApp (LId "fack", [ LId "n" ]), [ LApp (LId "anon$2", [ LId "n" ]) ]) ) + ) ] ;; @@ -263,14 +274,31 @@ ll_ok "ll_1" (lambda_lifting cc1) ll1 let ll2 = [ LFun ( "h" - , [ "a"; "c"; "d"; "e" ] - , LMul (LApp ("a", []), LAdd (LApp ("c", []), LMul (LApp ("d", []), LApp ("e", [])))) - ) + , [ "c"; "d"; "a"; "e" ] + , LMul (LId "a", LAdd (LId "c", LMul (LId "d", LId "e"))) ) ; LFun ( "g" , [ "a"; "c"; "d" ] - , LApp ("h", [ LApp ("a", []); LApp ("c", []); LApp ("d", []); LConst (CInt 4) ]) ) - ; LFun ("f", [ "a" ], LApp ("g", [ LApp ("a", []); LConst (CInt 2); LConst (CInt 3) ])) + , LIn + ( "h" + , LMul (LId "a", LAdd (LId "c", LMul (LId "d", LId "e"))) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "d" ]), [ LId "a" ]) + , [ LConst (CInt 4) ] ) ) ) + ; LFun + ( "f" + , [ "a" ] + , LIn + ( "g" + , LIn + ( "h" + , LMul (LId "a", LAdd (LId "c", LMul (LId "d", LId "e"))) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "d" ]), [ LId "a" ]) + , [ LConst (CInt 4) ] ) ) + , LApp + ( LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]) + , [ LConst (CInt 3) ] ) ) ) ] ;; @@ -279,64 +307,107 @@ ll_ok "ll_2" (lambda_lifting cc2) ll2 let ll3 = [ LFun ( "anon$1" - , [ "c"; "b"; "a"; "x" ] - , LMul (LId "x", LApp ("a", [ LMul (LId "c", LId "b") ])) ) + , [ "c"; "a"; "b"; "x" ] + , LMul (LId "x", LApp (LId "a", [ LMul (LId "c", LId "b") ])) ) ; LFun ( "h" - , [ "c"; "b"; "a" ] - , LApp ("anon$1", [ LApp ("c", []); LApp ("b", []); LApp ("a", []) ]) ) + , [ "c"; "a"; "b" ] + , LApp (LApp (LApp (LId "anon$1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) ) ; LFun ( "g" - , [ "b"; "a"; "c" ] - , LApp ("h", [ LApp ("c", []); LApp ("b", []); LApp ("a", []); LApp ("a", []) ]) ) + , [ "a"; "b"; "c" ] + , LIn + ( "h" + , LApp (LApp (LApp (LId "anon$1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) + , [ LId "a" ] ) ) ) ; LFun - ("f", [ "a"; "b" ], LApp ("g", [ LApp ("b", []); LApp ("a", []); LConst (CInt 3) ])) + ( "f" + , [ "a"; "b" ] + , LIn + ( "g" + , LIn + ( "h" + , LApp (LApp (LApp (LId "anon$1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) + , [ LId "a" ] ) ) + , LApp (LApp (LApp (LId "g", [ LId "a" ]), [ LId "b" ]), [ LConst (CInt 3) ]) ) + ) ] ;; ll_ok "ll_3" (lambda_lifting cc3) ll3 let ll4 = - [ LFun - ( "h" - , [ "a"; "b"; "c" ] - , LMul (LApp ("a", []), LDiv (LApp ("b", []), LApp ("c", []))) ) + [ LFun ("h", [ "a"; "a"; "b"; "c" ], LMul (LId "a", LDiv (LId "b", LId "c"))) ; LFun - ("g", [ "a"; "b" ], LApp ("h", [ LApp ("a", []); LConst (CInt 2); LConst (CInt 3) ])) + ( "g" + , [ "a"; "b" ] + , LIn + ( "h" + , LMul (LId "a", LDiv (LId "b", LId "c")) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]), [ LConst (CInt 2) ]) + , [ LConst (CInt 3) ] ) ) ) ; LFun ( "f" , [ "a" ] - , LApp ("g", [ LAdd (LConst (CInt 1), LConst (CInt 0)); LApp ("a", []) ]) ) + , LIn + ( "g" + , LIn + ( "h" + , LMul (LId "a", LDiv (LId "b", LId "c")) + , LApp + ( LApp + ( LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]) + , [ LConst (CInt 2) ] ) + , [ LConst (CInt 3) ] ) ) + , LApp (LApp (LId "g", [ LAdd (LConst (CInt 1), LConst (CInt 0)) ]), [ LId "a" ]) + ) ) ] ;; ll_ok "ll_4" (lambda_lifting cc4) ll4 let ll5 = - [ LFun ("g", [ "a"; "b" ], LDiv (LApp ("a", []), LApp ("b", []))) - ; LFun ("h", [ "a"; "c" ], LMul (LId "a", LApp ("c", []))) + [ LFun ("g", [ "a"; "b" ], LDiv (LId "a", LId "b")) + ; LFun ("h", [ "a"; "c" ], LMul (LId "a", LId "c")) ; LFun ( "f" , [ "a" ] - , LAdd - ( LApp ("h", [ LApp ("a", []); LConst (CInt 1) ]) - , LApp ("g", [ LApp ("a", []); LConst (CInt 2) ]) ) ) + , LIn + ( "g" + , LDiv (LId "a", LId "b") + , LIn + ( "h" + , LMul (LId "a", LId "c") + , LAdd + ( LApp (LApp (LId "h", [ LId "a" ]), [ LConst (CInt 1) ]) + , LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]) ) ) ) ) ] ;; ll_ok "ll_5" (lambda_lifting cc5) ll5 let ll6 = - [ LFun ("anon$1", [ "x" ], LId "x") - ; LFun ("g", [], LApp ("anon$1", [])) + [ LFun ("anon$1", [ "a"; "x" ], LId "x") + ; LFun ("g", [ "a" ], LApp (LId "anon$1", [ LId "a" ])) ; LFun ("anon$2", [ "a"; "x" ], LMul (LId "a", LId "x")) - ; LFun ("h", [ "a" ], LApp ("anon$2", [ LApp ("a", []) ])) + ; LFun ("h", [ "a" ], LApp (LId "anon$2", [ LId "a" ])) ; LFun ( "f" , [ "a" ] - , LAdd - (LApp ("g", [ LApp ("a", []) ]), LApp ("h", [ LApp ("a", []); LApp ("a", []) ])) - ) + , LIn + ( "g" + , LApp (LId "anon$1", [ LId "a" ]) + , LIn + ( "h" + , LApp (LId "anon$2", [ LId "a" ]) + , LAdd + ( LApp (LApp (LId "g", [ LId "a" ]), [ LId "a" ]) + , LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]) ) ) ) ) ] ;; @@ -370,7 +441,7 @@ let anf_ok n ll expected = let anf1 = [ AFun ( "anon$1" - , [ "k"; "n"; "m" ] + , [ "n"; "k"; "n"; "m" ] , ALet ( "anf_op#1" , AMul (AId "m", AId "n") @@ -397,29 +468,56 @@ let anf1 = , ACExpr (CImmExpr (AId "anf_app#6")) ) ) , ALet ( "anf_app#7" - , AApp (AId "k", []) + , AApp (AId "anon$1", [ AId "n" ]) , ALet ( "anf_app#8" - , AApp (AId "n", []) + , AApp (AId "anf_app#7", [ AId "k" ]) , ALet ( "anf_app#9" - , AApp (AId "anon$1", [ AId "anf_app#7"; AId "anf_app#8" ]) + , AApp (AId "anf_app#8", [ AId "n" ]) , ACExpr (CImmExpr (AId "anf_app#9")) ) ) ) ) , ACExpr (CImmExpr (AId "anf_if#4")) ) ) ) - ; AFun ("anon$2", [ "x" ], ACExpr (CImmExpr (AId "x"))) + ; AFun ("anon$2", [ "n"; "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun ( "fac" , [ "n" ] , ALet - ( "anf_app#10" - , AApp (AId "n", []) + ( "anf_op#10" + , ALte (AId "n", AInt 1) , ALet - ( "anf_app#11" - , AApp (AId "anon$2", []) + ( "anf_if#11" + , AIf + ( AId "anf_op#10" + , ALet + ( "anf_op#12" + , ASub (AId "n", AInt 1) + , ALet + ( "anf_app#13" + , AApp (AId "n", [ AId "anf_op#12" ]) + , ACExpr (CImmExpr (AId "anf_app#13")) ) ) + , ALet + ( "anf_app#14" + , AApp (AId "anon$1", [ AId "n" ]) + , ALet + ( "anf_app#15" + , AApp (AId "anf_app#14", [ AId "k" ]) + , ALet + ( "anf_app#16" + , AApp (AId "anf_app#15", [ AId "n" ]) + , ACExpr (CImmExpr (AId "anf_app#16")) ) ) ) ) , ALet - ( "anf_app#12" - , AApp (AId "fack", [ AId "anf_app#10"; AId "anf_app#11" ]) - , ACExpr (CImmExpr (AId "anf_app#12")) ) ) ) ) + ( "fack" + , CImmExpr (AId "anf_if#11") + , ALet + ( "anf_app#17" + , AApp (AId "fack", [ AId "n" ]) + , ALet + ( "anf_app#18" + , AApp (AId "anon$2", [ AId "n" ]) + , ALet + ( "anf_app#19" + , AApp (AId "anf_app#17", [ AId "anf_app#18" ]) + , ACExpr (CImmExpr (AId "anf_app#19")) ) ) ) ) ) ) ) ] ;; @@ -428,46 +526,77 @@ let%test _ = anf_ok "anf_1" ll1 anf1 let anf4 = [ AFun ( "h" - , [ "a"; "b"; "c" ] + , [ "a"; "a"; "b"; "c" ] , ALet - ( "anf_app#1" - , AApp (AId "a", []) + ( "anf_op#1" + , ADiv (AId "b", AId "c") , ALet - ( "anf_app#2" - , AApp (AId "b", []) - , ALet - ( "anf_app#3" - , AApp (AId "c", []) - , ALet - ( "anf_op#4" - , ADiv (AId "anf_app#2", AId "anf_app#3") - , ALet - ( "anf_op#5" - , AMul (AId "anf_app#1", AId "anf_op#4") - , ACExpr (CImmExpr (AId "anf_op#5")) ) ) ) ) ) ) + ( "anf_op#2" + , AMul (AId "a", AId "anf_op#1") + , ACExpr (CImmExpr (AId "anf_op#2")) ) ) ) ; AFun ( "g" , [ "a"; "b" ] , ALet - ( "anf_app#6" - , AApp (AId "a", []) + ( "anf_op#3" + , ADiv (AId "b", AId "c") , ALet - ( "anf_app#7" - , AApp (AId "h", [ AId "anf_app#6"; AInt 2; AInt 3 ]) - , ACExpr (CImmExpr (AId "anf_app#7")) ) ) ) + ( "anf_op#4" + , AMul (AId "a", AId "anf_op#3") + , ALet + ( "h" + , CImmExpr (AId "anf_op#4") + , ALet + ( "anf_app#5" + , AApp (AId "h", [ AId "a" ]) + , ALet + ( "anf_app#6" + , AApp (AId "anf_app#5", [ AId "a" ]) + , ALet + ( "anf_app#7" + , AApp (AId "anf_app#6", [ AInt 2 ]) + , ALet + ( "anf_app#8" + , AApp (AId "anf_app#7", [ AInt 3 ]) + , ACExpr (CImmExpr (AId "anf_app#8")) ) ) ) ) ) ) ) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_op#8" - , AAdd (AInt 1, AInt 0) + ( "anf_op#9" + , ADiv (AId "b", AId "c") , ALet - ( "anf_app#9" - , AApp (AId "a", []) + ( "anf_op#10" + , AMul (AId "a", AId "anf_op#9") , ALet - ( "anf_app#10" - , AApp (AId "g", [ AId "anf_op#8"; AId "anf_app#9" ]) - , ACExpr (CImmExpr (AId "anf_app#10")) ) ) ) ) + ( "h" + , CImmExpr (AId "anf_op#10") + , ALet + ( "anf_app#11" + , AApp (AId "h", [ AId "a" ]) + , ALet + ( "anf_app#12" + , AApp (AId "anf_app#11", [ AId "a" ]) + , ALet + ( "anf_app#13" + , AApp (AId "anf_app#12", [ AInt 2 ]) + , ALet + ( "anf_app#14" + , AApp (AId "anf_app#13", [ AInt 3 ]) + , ALet + ( "g" + , CImmExpr (AId "anf_app#14") + , ALet + ( "anf_op#15" + , AAdd (AInt 1, AInt 0) + , ALet + ( "anf_app#16" + , AApp (AId "g", [ AId "anf_op#15" ]) + , ALet + ( "anf_app#17" + , AApp (AId "anf_app#16", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app#17")) + ) ) ) ) ) ) ) ) ) ) ) ) ] ;; @@ -477,57 +606,57 @@ let anf5 = [ AFun ( "g" , [ "a"; "b" ] - , ALet - ( "anf_app#1" - , AApp (AId "a", []) - , ALet - ( "anf_app#2" - , AApp (AId "b", []) - , ALet - ( "anf_op#3" - , ADiv (AId "anf_app#1", AId "anf_app#2") - , ACExpr (CImmExpr (AId "anf_op#3")) ) ) ) ) + , ALet ("anf_op#1", ADiv (AId "a", AId "b"), ACExpr (CImmExpr (AId "anf_op#1"))) ) ; AFun ( "h" , [ "a"; "c" ] - , ALet - ( "anf_app#4" - , AApp (AId "c", []) - , ALet - ( "anf_op#5" - , AMul (AId "a", AId "anf_app#4") - , ACExpr (CImmExpr (AId "anf_op#5")) ) ) ) + , ALet ("anf_op#2", AMul (AId "a", AId "c"), ACExpr (CImmExpr (AId "anf_op#2"))) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_app#6" - , AApp (AId "a", []) + ( "anf_op#3" + , ADiv (AId "a", AId "b") , ALet - ( "anf_app#7" - , AApp (AId "h", [ AId "anf_app#6"; AInt 1 ]) + ( "g" + , CImmExpr (AId "anf_op#3") , ALet - ( "anf_app#8" - , AApp (AId "a", []) + ( "anf_op#4" + , AMul (AId "a", AId "c") , ALet - ( "anf_app#9" - , AApp (AId "g", [ AId "anf_app#8"; AInt 2 ]) + ( "h" + , CImmExpr (AId "anf_op#4") , ALet - ( "anf_op#10" - , AAdd (AId "anf_app#7", AId "anf_app#9") - , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ) ) ) + ( "anf_app#5" + , AApp (AId "h", [ AId "a" ]) + , ALet + ( "anf_app#6" + , AApp (AId "anf_app#5", [ AInt 1 ]) + , ALet + ( "anf_app#7" + , AApp (AId "g", [ AId "a" ]) + , ALet + ( "anf_app#8" + , AApp (AId "anf_app#7", [ AInt 2 ]) + , ALet + ( "anf_op#9" + , AAdd (AId "anf_app#6", AId "anf_app#8") + , ACExpr (CImmExpr (AId "anf_op#9")) ) ) ) ) ) + ) ) ) ) ) ] ;; let%test _ = anf_ok "anf_5" ll5 anf5 let anf6 = - [ AFun ("anon$1", [ "x" ], ACExpr (CImmExpr (AId "x"))) + [ AFun ("anon$1", [ "a"; "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun ( "g" - , [] - , ALet ("anf_app#1", AApp (AId "anon$1", []), ACExpr (CImmExpr (AId "anf_app#1"))) - ) + , [ "a" ] + , ALet + ( "anf_app#1" + , AApp (AId "anon$1", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app#1")) ) ) ; AFun ( "anon$2" , [ "a"; "x" ] @@ -537,34 +666,41 @@ let anf6 = , [ "a" ] , ALet ( "anf_app#3" - , AApp (AId "a", []) - , ALet - ( "anf_app#4" - , AApp (AId "anon$2", [ AId "anf_app#3" ]) - , ACExpr (CImmExpr (AId "anf_app#4")) ) ) ) + , AApp (AId "anon$2", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app#3")) ) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_app#5" - , AApp (AId "a", []) + ( "anf_app#4" + , AApp (AId "anon$1", [ AId "a" ]) , ALet - ( "anf_app#6" - , AApp (AId "g", [ AId "anf_app#5" ]) + ( "g" + , CImmExpr (AId "anf_app#4") , ALet - ( "anf_app#7" - , AApp (AId "a", []) + ( "anf_app#5" + , AApp (AId "anon$2", [ AId "a" ]) , ALet - ( "anf_app#8" - , AApp (AId "a", []) + ( "h" + , CImmExpr (AId "anf_app#5") , ALet - ( "anf_app#9" - , AApp (AId "h", [ AId "anf_app#7"; AId "anf_app#8" ]) + ( "anf_app#6" + , AApp (AId "g", [ AId "a" ]) , ALet - ( "anf_op#10" - , AAdd (AId "anf_app#6", AId "anf_app#9") - , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ) ) ) ) + ( "anf_app#7" + , AApp (AId "anf_app#6", [ AId "a" ]) + , ALet + ( "anf_app#8" + , AApp (AId "h", [ AId "a" ]) + , ALet + ( "anf_app#9" + , AApp (AId "anf_app#8", [ AId "a" ]) + , ALet + ( "anf_op#10" + , AAdd (AId "anf_app#7", AId "anf_app#9") + , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ) ) + ) ) ) ) ) ] ;; -let%test _ = anf_ok "anf_6" ll6 anf6 *) +let%test _ = anf_ok "anf_6" ll6 anf6 diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 1672ab4ef..1c38d1591 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -1,4 +1,348 @@ $ dune exec anf_conv_test << EOF + > let fac n = + > let rec fack n k = if (n<=1) + > then n (n-1) + > else (fun m -> k * m*n) + > in fack n (fun x -> x) + > ;; + > EOF + (fun anon$1(n k n m)-> + (let anf_op#1=(k*m) + in + (let anf_op#2=(anf_op#1*n) + in + anf_op#2)) + ) + (fun fack(n k)-> + (let anf_op#3=(n<=1) + in + (let anf_if#4=if (anf_op#3) + then ( + (let anf_op#5=(n-1) + in + (let anf_app#6=(n anf_op#5) + in + anf_app#6)) + ) else ( + (let anf_app#7=(anon$1 n) + in + (let anf_app#8=(anf_app#7 k) + in + (let anf_app#9=(anf_app#8 n) + in + anf_app#9)))) + in + anf_if#4)) + ) + (fun anon$2(n x)-> + x + ) + (fun fac(n)-> + (let anf_op#10=(n<=1) + in + (let anf_if#11=if (anf_op#10) + then ( + (let anf_op#12=(n-1) + in + (let anf_app#13=(n anf_op#12) + in + anf_app#13)) + ) else ( + (let anf_app#14=(anon$1 n) + in + (let anf_app#15=(anf_app#14 k) + in + (let anf_app#16=(anf_app#15 n) + in + anf_app#16)))) + in + (let fack=anf_if#11 + in + (let anf_app#17=(fack n) + in + (let anf_app#18=(anon$2 n) + in + (let anf_app#19=(anf_app#17 anf_app#18) + in + anf_app#19)))))) + ) + $ 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(c d a 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(a c d)-> + (let anf_op#4=(d*e) + in + (let anf_op#5=(c+anf_op#4) + in + (let anf_op#6=(a*anf_op#5) + in + (let h=anf_op#6 + in + (let anf_app#7=(h c) + in + (let anf_app#8=(anf_app#7 d) + in + (let anf_app#9=(anf_app#8 a) + in + (let anf_app#10=(anf_app#9 4) + in + anf_app#10)))))))) + ) + (fun f(a)-> + (let anf_op#11=(d*e) + in + (let anf_op#12=(c+anf_op#11) + in + (let anf_op#13=(a*anf_op#12) + in + (let h=anf_op#13 + in + (let anf_app#14=(h c) + in + (let anf_app#15=(anf_app#14 d) + in + (let anf_app#16=(anf_app#15 a) + in + (let anf_app#17=(anf_app#16 4) + in + (let g=anf_app#17 + in + (let anf_app#18=(g a) + in + (let anf_app#19=(anf_app#18 2) + in + (let anf_app#20=(anf_app#19 3) + in + anf_app#20)))))))))))) + ) + $ dune exec anf_conv_test << EOF + > let f a b = + > let g c = + > let h = (fun x -> x*(a (c*b))) in + > h a in + > g 3 + > ;; + > EOF + (fun anon$1(c a b x)-> + (let anf_op#1=(c*b) + in + (let anf_app#2=(a anf_op#1) + in + (let anf_op#3=(x*anf_app#2) + in + anf_op#3))) + ) + (fun h(c a b)-> + (let anf_app#4=(anon$1 c) + in + (let anf_app#5=(anf_app#4 a) + in + (let anf_app#6=(anf_app#5 b) + in + anf_app#6))) + ) + (fun g(a b c)-> + (let anf_app#7=(anon$1 c) + in + (let anf_app#8=(anf_app#7 a) + in + (let anf_app#9=(anf_app#8 b) + in + (let h=anf_app#9 + in + (let anf_app#10=(h c) + in + (let anf_app#11=(anf_app#10 a) + in + (let anf_app#12=(anf_app#11 b) + in + (let anf_app#13=(anf_app#12 a) + in + anf_app#13)))))))) + ) + (fun f(a b)-> + (let anf_app#14=(anon$1 c) + in + (let anf_app#15=(anf_app#14 a) + in + (let anf_app#16=(anf_app#15 b) + in + (let h=anf_app#16 + in + (let anf_app#17=(h c) + in + (let anf_app#18=(anf_app#17 a) + in + (let anf_app#19=(anf_app#18 b) + in + (let anf_app#20=(anf_app#19 a) + in + (let g=anf_app#20 + in + (let anf_app#21=(g a) + in + (let anf_app#22=(anf_app#21 b) + in + (let anf_app#23=(anf_app#22 3) + in + anf_app#23)))))))))))) + ) + $ dune exec anf_conv_test << EOF + > let f a = + > let g a b= + > let h b c= a*(b/c) in + > h 2 3 in + > g (1+0) a + > ;; + > EOF + (fun h(a a b c)-> + (let anf_op#1=(b/c) + in + (let anf_op#2=(a*anf_op#1) + in + anf_op#2)) + ) + (fun g(a b)-> + (let anf_op#3=(b/c) + in + (let anf_op#4=(a*anf_op#3) + in + (let h=anf_op#4 + in + (let anf_app#5=(h a) + in + (let anf_app#6=(anf_app#5 a) + in + (let anf_app#7=(anf_app#6 2) + in + (let anf_app#8=(anf_app#7 3) + in + anf_app#8))))))) + ) + (fun f(a)-> + (let anf_op#9=(b/c) + in + (let anf_op#10=(a*anf_op#9) + in + (let h=anf_op#10 + in + (let anf_app#11=(h a) + in + (let anf_app#12=(anf_app#11 a) + in + (let anf_app#13=(anf_app#12 2) + in + (let anf_app#14=(anf_app#13 3) + in + (let g=anf_app#14 + in + (let anf_op#15=(1+0) + in + (let anf_app#16=(g anf_op#15) + in + (let anf_app#17=(anf_app#16 a) + in + anf_app#17))))))))))) + ) + $ dune exec anf_conv_test << EOF + > let f a = + > let g b = a / b in + > let h c = (a * c) in + > ((h 1) + (g 2)) + > ;; + > EOF + (fun g(a b)-> + (let anf_op#1=(a/b) + in + anf_op#1) + ) + (fun h(a c)-> + (let anf_op#2=(a*c) + in + anf_op#2) + ) + (fun f(a)-> + (let anf_op#3=(a/b) + in + (let g=anf_op#3 + in + (let anf_op#4=(a*c) + in + (let h=anf_op#4 + in + (let anf_app#5=(h a) + in + (let anf_app#6=(anf_app#5 1) + in + (let anf_app#7=(g a) + in + (let anf_app#8=(anf_app#7 2) + in + (let anf_op#9=(anf_app#6+anf_app#8) + in + anf_op#9))))))))) + ) + $ dune exec anf_conv_test << EOF + > let f a = + > let g = (fun x -> x) in + > let h = (fun x -> a * x) in + > ((g a) + (h a)) + > ;; + > EOF + (fun anon$1(a x)-> + x + ) + (fun g(a)-> + (let anf_app#1=(anon$1 a) + in + anf_app#1) + ) + (fun anon$2(a x)-> + (let anf_op#2=(a*x) + in + anf_op#2) + ) + (fun h(a)-> + (let anf_app#3=(anon$2 a) + in + anf_app#3) + ) + (fun f(a)-> + (let anf_app#4=(anon$1 a) + in + (let g=anf_app#4 + in + (let anf_app#5=(anon$2 a) + in + (let h=anf_app#5 + in + (let anf_app#6=(g a) + in + (let anf_app#7=(anf_app#6 a) + in + (let anf_app#8=(h a) + in + (let anf_app#9=(anf_app#8 a) + in + (let anf_op#10=(anf_app#7+anf_app#9) + in + anf_op#10))))))))) + ) + $ 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)) @@ -148,50 +492,36 @@ in (let anf_app#9=(anf_app#8 a) in - (let anf_app#10=(anf_app#9 c) - in - (let anf_app#11=(anf_app#10 d) - in - (let anf_app#12=(anf_app#11 a) - in - (let anf_app#13=(anf_app#12 4) + (let anf_app#10=(anf_app#9 4) in - anf_app#13))))))))))) + anf_app#10)))))))) ) (fun f(a)-> - (let anf_op#14=(d*e) - in - (let anf_op#15=(c+anf_op#14) - in - (let anf_op#16=(a*anf_op#15) - in - (let h=anf_op#16 - in - (let anf_app#17=(h c) + (let anf_op#11=(d*e) in - (let anf_app#18=(anf_app#17 d) + (let anf_op#12=(c+anf_op#11) in - (let anf_app#19=(anf_app#18 a) + (let anf_op#13=(a*anf_op#12) in - (let anf_app#20=(anf_app#19 c) + (let h=anf_op#13 in - (let anf_app#21=(anf_app#20 d) + (let anf_app#14=(h c) in - (let anf_app#22=(anf_app#21 a) + (let anf_app#15=(anf_app#14 d) in - (let anf_app#23=(anf_app#22 4) + (let anf_app#16=(anf_app#15 a) in - (let g=anf_app#23 + (let anf_app#17=(anf_app#16 4) in - (let anf_app#24=(g a) + (let g=anf_app#17 in - (let anf_app#25=(anf_app#24 a) + (let anf_app#18=(g a) in - (let anf_app#26=(anf_app#25 2) + (let anf_app#19=(anf_app#18 2) in - (let anf_app#27=(anf_app#26 3) + (let anf_app#20=(anf_app#19 3) in - anf_app#27)))))))))))))))) + anf_app#20)))))))))))) ) $ dune exec anf_conv_test < manytests/do_not_type/001.ml Id fac not found in env @@ -202,15 +532,13 @@ then ( 1 ) else ( - (let anf_app#3=(fac n) - in - (let anf_op#4=(n-1) + (let anf_op#3=(n-1) in - (let anf_app#5=(anf_app#3 anf_op#4) + (let anf_app#4=(fac anf_op#3) in - (let anf_op#6=(n*anf_app#5) + (let anf_op#5=(n*anf_app#4) in - anf_op#6))))) + anf_op#5)))) in anf_if#2)) ) @@ -255,13 +583,11 @@ anf_app#8)) ) (fun anon$3(x)-> - (let anf_app#9=(f x) - in - (let anf_app#10=(anon$4 x) + (let anf_app#9=(anon$4 x) in - (let anf_app#11=(anf_app#9 anf_app#10) + (let anf_app#10=(f anf_app#9) in - anf_app#11))) + anf_app#10)) ) $ dune exec anf_conv_test < manytests/typed/001fac.ml (fun fac(n)-> diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index bc4d46346..302c27e03 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -1,4 +1,56 @@ $ dune exec clos_conv_test << EOF + > let fac n = + > let rec fack n k = if (n<=1) + > then n (n-1) + > else (fun m -> k * m*n) + > in fack n (fun x -> x) + > ;; + > EOF + (let fac n=(let rec fack n k=if ((n<=1)) then ((n (n-1))) else (((fun n k n m->((k*m)*n)) n k n)) in (fack n ((fun n x->x) 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 c d a e=(a*(c+(d*e))) in ((h c d a) 4)) in ((g a) 2 3))) + $ dune exec clos_conv_test << EOF + > let f a b = + > let g c = + > let h = (fun x -> x*(a (c*b))) in + > h a in + > g 3 + > ;; + > EOF + (let f a b=(let g a b c=(let h c a b=((fun c a b x->(x*(a (c*b)))) c a b) in ((h c a b) a)) in ((g a b) 3))) + $ dune exec clos_conv_test << EOF + > let f a = + > let g a b= + > let h b c= a*(b/c) in + > h 2 3 in + > g (1+0) a + > ;; + > EOF + (let f a=(let g a b=(let h a a b c=(a*(b/c)) in ((h a a) 2 3)) in (g (1+0) a))) + $ dune exec clos_conv_test << EOF + > let f a = + > let g b = a / b in + > let h c = (a * c) in + > ((h 1) + (g 2)) + > ;; + > EOF + (let f a=(let g a b=(a/b) in (let h a c=(a*c) in (((h a) 1)+((g a) 2))))) + $ dune exec clos_conv_test << EOF + > let f a = + > let g = (fun x -> x) in + > let h = (fun x -> a * x) in + > ((g a) + (h a)) + > ;; + > EOF + (let f a=(let g a=((fun a x->x) a) in (let h a=((fun a x->(a*x)) a) in (((g a) a)+((h a) a))))) + $ 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)) @@ -20,7 +72,7 @@ > in > (g 2 3) > EOF - (let f a=(let g a c d=(let h c a e d=(a*(c+(d*e))) in ((h c a) c a 4)) in ((g a) a 2 3))) + (let f a=(let g a c d=(let h c a e d=(a*(c+(d*e))) in ((h c a) 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) > 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 d42c4ead3..b57846275 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -1,4 +1,72 @@ $ dune exec lambda_lifting_test << EOF + > let fac n = + > let rec fack n k = if (n<=1) + > then n (n-1) + > else (fun m -> k * m*n) + > in fack n (fun x -> x) + > ;; + > EOF + (fun anon$1(n k n m)->(((k*m)*n))) + (fun fack(n k)->(if ((n<=1)) then ({n (n-1)}) else ({{{anon$1 n} k} n}))) + (fun anon$2(n x)->(x)) + (fun fac(n)->(let fack = (if ((n<=1)) then ({n (n-1)}) else ({{{anon$1 n} k} n}) in {{fack n} {anon$2 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(c d a e)->((a*(c+(d*e))))) + (fun g(a c d)->(let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}))) + (fun f(a)->(let g = (let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}) in {{{g a} 2} 3}))) + $ dune exec lambda_lifting_test << EOF + > let f a b = + > let g c = + > let h = (fun x -> x*(a (c*b))) in + > h a in + > g 3 + > ;; + > EOF + (fun anon$1(c a b x)->((x*{a (c*b)}))) + (fun h(c a b)->({{{anon$1 c} a} b})) + (fun g(a b c)->(let h = ({{{anon$1 c} a} b} in {{{{h c} a} b} a}))) + (fun f(a b)->(let g = (let h = ({{{anon$1 c} a} b} in {{{{h c} a} b} a}) in {{{g a} b} 3}))) + $ dune exec lambda_lifting_test << EOF + > let f a = + > let g a b= + > let h b c= a*(b/c) in + > h 2 3 in + > g (1+0) a + > ;; + > EOF + (fun h(a a b c)->((a*(b/c)))) + (fun g(a b)->(let h = ((a*(b/c)) in {{{{h a} a} 2} 3}))) + (fun f(a)->(let g = (let h = ((a*(b/c)) in {{{{h a} a} 2} 3}) in {{g (1+0)} a}))) + $ dune exec lambda_lifting_test << EOF + > let f a = + > let g b = a / b in + > let h c = (a * c) in + > ((h 1) + (g 2)) + > ;; + > EOF + (fun g(a b)->((a/b))) + (fun h(a c)->((a*c))) + (fun f(a)->(let g = ((a/b) in let h = ((a*c) in ({{h a} 1}+{{g a} 2}))))) + $ dune exec lambda_lifting_test << EOF + > let f a = + > let g = (fun x -> x) in + > let h = (fun x -> a * x) in + > ((g a) + (h a)) + > ;; + > EOF + (fun anon$1(a x)->(x)) + (fun g(a)->({anon$1 a})) + (fun anon$2(a x)->((a*x))) + (fun h(a)->({anon$2 a})) + (fun f(a)->(let g = ({anon$1 a} in let h = ({anon$2 a} in ({{g a} a}+{{h a} a}))))) + $ 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)) @@ -25,11 +93,11 @@ > (g 2 3) > EOF (fun h(c d a e)->((a*(c+(d*e))))) - (fun g(a c d)->(let h = ((a*(c+(d*e))) in {{{{{{{h c} d} a} c} d} a} 4}))) - (fun f(a)->(let g = (let h = ((a*(c+(d*e))) in {{{{{{{h c} d} a} c} d} a} 4}) in {{{{g a} a} 2} 3}))) + (fun g(a c d)->(let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}))) + (fun f(a)->(let g = (let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}) in {{{g a} 2} 3}))) $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml Id fac not found in env - (fun recfac(n)->(if ((n<=1)) then (1) else ((n*{{fac n} (n-1)})))) + (fun recfac(n)->(if ((n<=1)) then (1) else ((n*{fac (n-1)})))) $ 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 @@ -38,7 +106,7 @@ (fun anon$1(f x)->({f {{anon$2 x} f}})) (fun fix(f)->({anon$1 f})) (fun anon$4(x f)->({{x x} f})) - (fun anon$3(x)->({{f x} {anon$4 x}})) + (fun anon$3(x)->({f {anon$4 x}})) $ 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/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index f23fcc172..33a064afd 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -1,4 +1,144 @@ $ dune exec riscv64_instr_test << EOF + > let f a = + > let g = (fun x -> x) in + > let h = (fun x -> a * x) in + > ((g a) + (h a)) + > ;; + > EOF + .attribute unaligned_access, 0 + .attribute stack_align, 16 + .global main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + anon_1: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a1,-32(s0) + sd a0,-24(s0) + mv a0,a1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + g: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-64(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a3,-64(s0) + li a2,1 + li a1,2 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + anon_2: + addi sp,sp,-48 + sd ra,32(sp) + sd s0,24(sp) + addi s0,sp,48 + sd a1,-48(s0) + sd a0,-40(s0) + mul t0,a0,a1 + mv a0,t0 + ld ra,32(sp) + ld s0,24(sp) + addi sp,sp,48 + ret + h: + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-64(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + ld a3,-64(s0) + li a2,1 + li a1,2 + call part_app + mv a0,a0 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 + ret + f: + addi sp,sp,-240 + sd ra,232(sp) + sd s0,224(sp) + addi s0,sp,240 + sd a0,-240(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a3,-240(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + sd a0,-40(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + ld a3,-240(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-48(s0) + sd a0,-56(s0) + lui a0,%hi(g) + addi a0,a0,%lo(g) + ld a3,-240(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-64(s0) + ld a0,-64(s0) + ld a3,-240(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-72(s0) + lui a0,%hi(h) + addi a0,a0,%lo(h) + ld a3,-240(s0) + li a2,1 + li a1,1 + call part_app + sd a0,-80(s0) + ld a0,-80(s0) + ld a3,-240(s0) + li a2,1 + li a1,0 + call part_app + ld t0,-72(s0) + add t1,t0,a0 + mv a0,t1 + ld ra,232(sp) + ld s0,224(sp) + addi sp,sp,240 + ret + $ 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)) From f589e6dfd0189561d1f03b737a8c4f1f3202b747 Mon Sep 17 00:00:00 2001 From: Ivan Date: Wed, 16 Apr 2025 06:25:58 +0300 Subject: [PATCH 35/45] Rename --- slarnML/test/{exec_test.t => exec_test.t_} | Bin 1 file changed, 0 insertions(+), 0 deletions(-) rename slarnML/test/{exec_test.t => exec_test.t_} (100%) 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_ From dffa1efef523a381474b9464e9ecf13eb83540ea Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 21 Apr 2025 05:11:46 +0300 Subject: [PATCH 36/45] Format and replace manytests --- slarnML/test/manytests | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/slarnML/test/manytests b/slarnML/test/manytests index 34b5bbb13..0bd48791d 120000 --- a/slarnML/test/manytests +++ b/slarnML/test/manytests @@ -1 +1 @@ -../../../manytests \ No newline at end of file +../../manytests \ No newline at end of file From fca208c51765bf50ce2c0ac7b98cac3fb983b9dc Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 21 Apr 2025 05:32:13 +0300 Subject: [PATCH 37/45] Fmt and promote test --- slarnML/lib/anf/clos_conv.ml | 10 ---- slarnML/lib/riscv64/riscv.ml | 88 +++++++++++++++--------------- slarnML/test/anf_conv_test.t | 18 +++--- slarnML/test/clos_conv_test.t | 4 +- slarnML/test/lambda_lifting_test.t | 4 +- slarnML/test/parser_tests.t | 4 +- slarnML/test/riscv64_instr_test.t | 46 +++++++--------- 7 files changed, 76 insertions(+), 98 deletions(-) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 0b946d5e8..69ea1e382 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -141,16 +141,6 @@ let rec closure_conversion ?(env = []) ?(prt_args = []) = function | Ast.App (func, args) -> let func_converted = closure_conversion ~env ~prt_args func in let args_converted = List.map (closure_conversion ~env ~prt_args) args in - (* let prt_args = - List.map - (fun arg -> CId arg) - (match func with - | Ast.Id id -> - (match List.find_opt (fun (name, _, _, _) -> name = id) env with - | None -> prt_args - | Some (_, _, _, args) -> args) - | _ -> prt_args) - in *) CApp (func_converted, args_converted) ;; diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index e1e08fefa..6c2190f28 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -323,15 +323,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 -> @@ -504,24 +504,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 @@ -543,23 +543,23 @@ let rec build_aexpr tag a res = | Some (_, cond) -> res >>= (fun env -> - Result ([], None, env) - |> build_aexpr tag e2 - >>= 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 e2 + >>= 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 e1 >>= fun (instr1, reg2, env) -> (match reg2 with diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 1c38d1591..03f72f54f 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -720,15 +720,15 @@ ) else ( (let anf_op#18=(n-1) in - (let anf_app#19=(fib anf_op#18) + (let anf_op#19=(n-2) in - (let anf_op#20=(n-2) + (let anf_app#20=(fib anf_op#19) in - (let anf_app#21=(fib anf_op#20) + (let anf_op#21=(anf_op#18+anf_app#20) in - (let anf_op#22=(anf_app#19+anf_app#21) + (let anf_app#22=(fib anf_op#21) in - anf_op#22)))))) + anf_app#22)))))) in anf_if#17)) ) @@ -855,13 +855,9 @@ in (let anf_app#35=(anf_app#34 100) in - (let temp3=anf_app#35 + (let temp2=anf_app#35 in - (let anf_app#36=(print_int temp3) - in - (let ()=anf_app#36 - in - 0))))))))))))))))))))))) + 0))))))))))))))))))))) ) $ dune exec anf_conv_test < manytests/typed/005fix.ml (fun fix(f x)-> diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index 302c27e03..b1eedbf9f 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -90,13 +90,13 @@ (let main=(let ()=(print_int (fac_cps 4 ((fun print_int->print_int) ))) in 0)) $ dune exec clos_conv_test < manytests/typed/003fib.ml (let rec fib_acc a b n=if ((n=1)) then (b) else ((let n1 a b n=(n-1) in (let ab a b n=(a+b) in (fib_acc b (ab a b n) (n1 a b n)))))) - (let rec fib n=if ((n<2)) then (n) else (((fib (n-1))+(fib (n-2))))) + (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_0 a b c=(print_int a) in (let b_0 a b c=(print_int b) in (let c_0 a b 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 rez=(wrap test10 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) in (let ()=(print_int rez) in (let temp3=(wrap test3 1 10 100) in (let ()=(print_int temp3) 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 b57846275..07faff6da 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -119,7 +119,7 @@ (fun n1(a b n)->((n-1))) (fun ab(a b n)->((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 a} b} n}} {{{n1 a} b} n}}))))) - (fun fib(n)->(if ((n<2)) then (n) else (({fib (n-1)}+{fib (n-2)})))) + (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))) @@ -128,7 +128,7 @@ (fun c_0(a b c)->({print_int c})) (fun test3(a b c)->(let a_0 = ({print_int a} in let b_0 = ({print_int b} in let c_0 = ({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 main()->(let rez = ({{{{{{{{{{{wrap {test10 }} 1} 10} 100} 1000} 10000} 100000} 1000000} 10000000} 100000000} 1000000000} in let () = ({print_int rez} in let temp3 = ({{{{wrap {test3 }} 1} 10} 100} in let () = ({print_int temp3} 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 12fbf7c9b..37f7923f8 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -106,13 +106,13 @@ (let main=(let ()=(print_int->(fac_cps->4->(fun print_int->print_int))) in 0)) $ dune exec parser_test < manytests/typed/003fib.ml (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 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 rez=(wrap->test10->1->10->100->1000->10000->100000->1000000->10000000->100000000->1000000000) in (let ()=(print_int->rez) in (let temp3=(wrap->test3->1->10->100) in (let ()=(print_int->temp3) 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 33a064afd..a6cb6bfea 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -661,31 +661,31 @@ blt a0,t0,.tag_anf_op_16 li t1,1 sub t2,a0,t1 + li t3,2 + sub t4,a0,t3 sd t2,-32(s0) + sd t4,-40(s0) lui a0,%hi(fib) addi a0,a0,%lo(fib) - ld a3,-32(s0) + ld a3,-40(s0) li a2,1 li a1,1 call part_app - ld t2,-128(s0) - li t1,2 - sub t0,t2,t1 - sd a0,-40(s0) - sd t0,-48(s0) + ld t4,-32(s0) + add t3,t4,a0 + sd a0,-48(s0) + sd t3,-56(s0) lui a0,%hi(fib) addi a0,a0,%lo(fib) - ld a3,-48(s0) + ld a3,-56(s0) li a2,1 li a1,1 call part_app - ld t0,-40(s0) - add t1,t0,a0 - sd a0,-56(s0) - mv a0,t1 j .tag_anf_op_16_t .tag_anf_op_16: - ld a0,-128(s0) + ld t3,-128(s0) + sd a0,-64(s0) + mv a0,t3 .tag_anf_op_16_t: mv a0,a0 ld ra,120(sp) @@ -907,10 +907,10 @@ addi sp,sp,160 ret main2: - addi sp,sp,-656 - sd ra,648(sp) - sd s0,640(sp) - addi s0,sp,656 + addi sp,sp,-624 + sd ra,608(sp) + sd s0,600(sp) + addi s0,sp,624 lui a0,%hi(test10) addi a0,a0,%lo(test10) li a2,0 @@ -1024,19 +1024,11 @@ li a1,0 call part_app sd a0,-184(s0) - sd a0,-192(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-192(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-200(s0) li t0,0 mv a0,t0 - ld ra,648(sp) - ld s0,640(sp) - addi sp,sp,656 + ld ra,608(sp) + ld s0,600(sp) + addi sp,sp,624 ret $ dune exec riscv64_instr_test < manytests/typed/005fix.ml From f0c57491b169093efb944362ff857e270a9ec119 Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 21 Apr 2025 05:38:37 +0300 Subject: [PATCH 38/45] Fmt --- slarnML/lib/riscv64/riscv.ml | 88 ++++++++++++++++++------------------ 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index 6c2190f28..b2409e5eb 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -323,15 +323,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 -> @@ -504,24 +504,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 @@ -543,23 +543,23 @@ let rec build_aexpr tag a res = | Some (_, cond) -> res >>= (fun env -> - Result ([], None, env) - |> build_aexpr tag e2 - >>= 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 e2 + >>= 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 e1 >>= fun (instr1, reg2, env) -> (match reg2 with From bdd1fcd8b97830f644dc08cf0ff4ca4abeaa4ac8 Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 21 Apr 2025 05:48:50 +0300 Subject: [PATCH 39/45] Fmt --- slarnML/.ocamlformat | 5 +- slarnML/lib/riscv64/riscv.ml | 88 ++++++++++++++++++------------------ 2 files changed, 46 insertions(+), 47 deletions(-) diff --git a/slarnML/.ocamlformat b/slarnML/.ocamlformat index b0368510d..f2d08264a 100644 --- a/slarnML/.ocamlformat +++ b/slarnML/.ocamlformat @@ -1,3 +1,2 @@ -profile=janestreet -sequence-style=terminator -max-indent=2 \ No newline at end of file +version=0.26.2 +profile=janestreet \ No newline at end of file diff --git a/slarnML/lib/riscv64/riscv.ml b/slarnML/lib/riscv64/riscv.ml index b2409e5eb..f04c4b0a2 100644 --- a/slarnML/lib/riscv64/riscv.ml +++ b/slarnML/lib/riscv64/riscv.ml @@ -323,15 +323,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 -> @@ -504,24 +504,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 @@ -543,23 +543,23 @@ let rec build_aexpr tag a res = | Some (_, cond) -> res >>= (fun env -> - Result ([], None, env) - |> build_aexpr tag e2 - >>= 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 e2 + >>= 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 e1 >>= fun (instr1, reg2, env) -> (match reg2 with From 1bf294d7d107bf344a3d040e2149d74862c06778 Mon Sep 17 00:00:00 2001 From: Ivan Date: Mon, 21 Apr 2025 17:53:34 +0300 Subject: [PATCH 40/45] Change format pp ANF --- slarnML/lib/anf/anf_conv.ml | 2 +- slarnML/lib/anf/lambda_lifting.ml | 2 +- slarnML/lib/pretty_print/pprint_anf.ml | 6 +- slarnML/lib/test/anf_test.ml | 260 +++--- slarnML/test/anf_conv_test.t | 1114 ++++++++++++------------ slarnML/test/lambda_lifting_test.t | 64 +- 6 files changed, 714 insertions(+), 734 deletions(-) diff --git a/slarnML/lib/anf/anf_conv.ml b/slarnML/lib/anf/anf_conv.ml index 6eeb1071c..1f3c972e3 100644 --- a/slarnML/lib/anf/anf_conv.ml +++ b/slarnML/lib/anf/anf_conv.ml @@ -19,7 +19,7 @@ let clear_free _ = let get_name name = let num = next_free () in - String.concat "" [ name; "#"; string_of_int num ] + String.concat "" [ name; "_"; string_of_int num ] ;; let rec anf_expr e expr_with_hole = diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 50d7e563c..baf274639 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -9,7 +9,7 @@ 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 ])) + map (fun (_, _, _, num) -> Result (String.concat "_" [ "anon"; string_of_int num ])) ;; let get_name id _ = diff --git a/slarnML/lib/pretty_print/pprint_anf.ml b/slarnML/lib/pretty_print/pprint_anf.ml index c934a2cf1..32e3f787c 100644 --- a/slarnML/lib/pretty_print/pprint_anf.ml +++ b/slarnML/lib/pretty_print/pprint_anf.ml @@ -55,7 +55,7 @@ let rec pp_anf_aexpr tab ae = | ALet (id, e1, e2) -> concat "" - [ "(let " + [ "let " ; id ; "=" ; pp_anf_cexpr next_tab e1 @@ -64,12 +64,12 @@ let rec pp_anf_aexpr tab ae = ; "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)" ] + concat "" [ "let "; id; " "; concat " " args; "=\n\t"; pp_anf_aexpr "\t" e; "\n" ] ;; diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml index e111a35ed..d087eef50 100644 --- a/slarnML/lib/test/anf_test.ml +++ b/slarnML/lib/test/anf_test.ml @@ -245,15 +245,15 @@ let ll_ok n res expected = ;; let ll1 = - [ LFun ("anon$1", [ "n"; "k"; "n"; "m" ], LMul (LId "k", LMul (LId "m", LId "n"))) + [ LFun ("anon_1", [ "n"; "k"; "n"; "m" ], LMul (LId "k", LMul (LId "m", LId "n"))) ; LFun ( "fack" , [ "n"; "k" ] , LIf ( LLte (LId "n", LConst (CInt 1)) , LApp (LId "n", [ LSub (LId "n", LConst (CInt 1)) ]) - , LApp (LApp (LApp (LId "anon$1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) ) ) - ; LFun ("anon$2", [ "n"; "x" ], LId "x") + , LApp (LApp (LApp (LId "anon_1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) ) ) + ; LFun ("anon_2", [ "n"; "x" ], LId "x") ; LFun ( "fac" , [ "n" ] @@ -262,9 +262,9 @@ let ll1 = , LIf ( LLte (LId "n", LConst (CInt 1)) , LApp (LId "n", [ LSub (LId "n", LConst (CInt 1)) ]) - , LApp (LApp (LApp (LId "anon$1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) + , LApp (LApp (LApp (LId "anon_1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) ) - , LApp (LApp (LId "fack", [ LId "n" ]), [ LApp (LId "anon$2", [ LId "n" ]) ]) ) + , LApp (LApp (LId "fack", [ LId "n" ]), [ LApp (LId "anon_2", [ LId "n" ]) ]) ) ) ] ;; @@ -306,19 +306,19 @@ ll_ok "ll_2" (lambda_lifting cc2) ll2 let ll3 = [ LFun - ( "anon$1" + ( "anon_1" , [ "c"; "a"; "b"; "x" ] , LMul (LId "x", LApp (LId "a", [ LMul (LId "c", LId "b") ])) ) ; LFun ( "h" , [ "c"; "a"; "b" ] - , LApp (LApp (LApp (LId "anon$1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) ) + , LApp (LApp (LApp (LId "anon_1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) ) ; LFun ( "g" , [ "a"; "b"; "c" ] , LIn ( "h" - , LApp (LApp (LApp (LId "anon$1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) + , LApp (LApp (LApp (LId "anon_1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) , LApp ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) , [ LId "a" ] ) ) ) @@ -329,7 +329,7 @@ let ll3 = ( "g" , LIn ( "h" - , LApp (LApp (LApp (LId "anon$1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) + , LApp (LApp (LApp (LId "anon_1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) , LApp ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) , [ LId "a" ] ) ) @@ -392,19 +392,19 @@ let ll5 = ll_ok "ll_5" (lambda_lifting cc5) ll5 let ll6 = - [ LFun ("anon$1", [ "a"; "x" ], LId "x") - ; LFun ("g", [ "a" ], LApp (LId "anon$1", [ LId "a" ])) - ; LFun ("anon$2", [ "a"; "x" ], LMul (LId "a", LId "x")) - ; LFun ("h", [ "a" ], LApp (LId "anon$2", [ LId "a" ])) + [ LFun ("anon_1", [ "a"; "x" ], LId "x") + ; LFun ("g", [ "a" ], LApp (LId "anon_1", [ LId "a" ])) + ; LFun ("anon_2", [ "a"; "x" ], LMul (LId "a", LId "x")) + ; LFun ("h", [ "a" ], LApp (LId "anon_2", [ LId "a" ])) ; LFun ( "f" , [ "a" ] , LIn ( "g" - , LApp (LId "anon$1", [ LId "a" ]) + , LApp (LId "anon_1", [ LId "a" ]) , LIn ( "h" - , LApp (LId "anon$2", [ LId "a" ]) + , LApp (LId "anon_2", [ LId "a" ]) , LAdd ( LApp (LApp (LId "g", [ LId "a" ]), [ LId "a" ]) , LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]) ) ) ) ) @@ -440,84 +440,84 @@ let anf_ok n ll expected = let anf1 = [ AFun - ( "anon$1" + ( "anon_1" , [ "n"; "k"; "n"; "m" ] , ALet - ( "anf_op#1" + ( "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")) ) ) ) + ( "anf_op_2" + , AMul (AId "k", AId "anf_op_1") + , ACExpr (CImmExpr (AId "anf_op_2")) ) ) ) ; AFun ( "fack" , [ "n"; "k" ] , ALet - ( "anf_op#3" + ( "anf_op_3" , ALte (AId "n", AInt 1) , ALet - ( "anf_if#4" + ( "anf_if_4" , AIf - ( AId "anf_op#3" + ( AId "anf_op_3" , ALet - ( "anf_op#5" + ( "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")) ) ) + ( "anf_app_6" + , AApp (AId "n", [ AId "anf_op_5" ]) + , ACExpr (CImmExpr (AId "anf_app_6")) ) ) , ALet - ( "anf_app#7" - , AApp (AId "anon$1", [ AId "n" ]) + ( "anf_app_7" + , AApp (AId "anon_1", [ AId "n" ]) , ALet - ( "anf_app#8" - , AApp (AId "anf_app#7", [ AId "k" ]) + ( "anf_app_8" + , AApp (AId "anf_app_7", [ AId "k" ]) , ALet - ( "anf_app#9" - , AApp (AId "anf_app#8", [ AId "n" ]) - , ACExpr (CImmExpr (AId "anf_app#9")) ) ) ) ) - , ACExpr (CImmExpr (AId "anf_if#4")) ) ) ) - ; AFun ("anon$2", [ "n"; "x" ], ACExpr (CImmExpr (AId "x"))) + ( "anf_app_9" + , AApp (AId "anf_app_8", [ AId "n" ]) + , ACExpr (CImmExpr (AId "anf_app_9")) ) ) ) ) + , ACExpr (CImmExpr (AId "anf_if_4")) ) ) ) + ; AFun ("anon_2", [ "n"; "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun ( "fac" , [ "n" ] , ALet - ( "anf_op#10" + ( "anf_op_10" , ALte (AId "n", AInt 1) , ALet - ( "anf_if#11" + ( "anf_if_11" , AIf - ( AId "anf_op#10" + ( AId "anf_op_10" , ALet - ( "anf_op#12" + ( "anf_op_12" , ASub (AId "n", AInt 1) , ALet - ( "anf_app#13" - , AApp (AId "n", [ AId "anf_op#12" ]) - , ACExpr (CImmExpr (AId "anf_app#13")) ) ) + ( "anf_app_13" + , AApp (AId "n", [ AId "anf_op_12" ]) + , ACExpr (CImmExpr (AId "anf_app_13")) ) ) , ALet - ( "anf_app#14" - , AApp (AId "anon$1", [ AId "n" ]) + ( "anf_app_14" + , AApp (AId "anon_1", [ AId "n" ]) , ALet - ( "anf_app#15" - , AApp (AId "anf_app#14", [ AId "k" ]) + ( "anf_app_15" + , AApp (AId "anf_app_14", [ AId "k" ]) , ALet - ( "anf_app#16" - , AApp (AId "anf_app#15", [ AId "n" ]) - , ACExpr (CImmExpr (AId "anf_app#16")) ) ) ) ) + ( "anf_app_16" + , AApp (AId "anf_app_15", [ AId "n" ]) + , ACExpr (CImmExpr (AId "anf_app_16")) ) ) ) ) , ALet ( "fack" - , CImmExpr (AId "anf_if#11") + , CImmExpr (AId "anf_if_11") , ALet - ( "anf_app#17" + ( "anf_app_17" , AApp (AId "fack", [ AId "n" ]) , ALet - ( "anf_app#18" - , AApp (AId "anon$2", [ AId "n" ]) + ( "anf_app_18" + , AApp (AId "anon_2", [ AId "n" ]) , ALet - ( "anf_app#19" - , AApp (AId "anf_app#17", [ AId "anf_app#18" ]) - , ACExpr (CImmExpr (AId "anf_app#19")) ) ) ) ) ) ) ) + ( "anf_app_19" + , AApp (AId "anf_app_17", [ AId "anf_app_18" ]) + , ACExpr (CImmExpr (AId "anf_app_19")) ) ) ) ) ) ) ) ] ;; @@ -528,74 +528,74 @@ let anf4 = ( "h" , [ "a"; "a"; "b"; "c" ] , ALet - ( "anf_op#1" + ( "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")) ) ) ) + ( "anf_op_2" + , AMul (AId "a", AId "anf_op_1") + , ACExpr (CImmExpr (AId "anf_op_2")) ) ) ) ; AFun ( "g" , [ "a"; "b" ] , ALet - ( "anf_op#3" + ( "anf_op_3" , ADiv (AId "b", AId "c") , ALet - ( "anf_op#4" - , AMul (AId "a", AId "anf_op#3") + ( "anf_op_4" + , AMul (AId "a", AId "anf_op_3") , ALet ( "h" - , CImmExpr (AId "anf_op#4") + , CImmExpr (AId "anf_op_4") , ALet - ( "anf_app#5" + ( "anf_app_5" , AApp (AId "h", [ AId "a" ]) , ALet - ( "anf_app#6" - , AApp (AId "anf_app#5", [ AId "a" ]) + ( "anf_app_6" + , AApp (AId "anf_app_5", [ AId "a" ]) , ALet - ( "anf_app#7" - , AApp (AId "anf_app#6", [ AInt 2 ]) + ( "anf_app_7" + , AApp (AId "anf_app_6", [ AInt 2 ]) , ALet - ( "anf_app#8" - , AApp (AId "anf_app#7", [ AInt 3 ]) - , ACExpr (CImmExpr (AId "anf_app#8")) ) ) ) ) ) ) ) ) + ( "anf_app_8" + , AApp (AId "anf_app_7", [ AInt 3 ]) + , ACExpr (CImmExpr (AId "anf_app_8")) ) ) ) ) ) ) ) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_op#9" + ( "anf_op_9" , ADiv (AId "b", AId "c") , ALet - ( "anf_op#10" - , AMul (AId "a", AId "anf_op#9") + ( "anf_op_10" + , AMul (AId "a", AId "anf_op_9") , ALet ( "h" - , CImmExpr (AId "anf_op#10") + , CImmExpr (AId "anf_op_10") , ALet - ( "anf_app#11" + ( "anf_app_11" , AApp (AId "h", [ AId "a" ]) , ALet - ( "anf_app#12" - , AApp (AId "anf_app#11", [ AId "a" ]) + ( "anf_app_12" + , AApp (AId "anf_app_11", [ AId "a" ]) , ALet - ( "anf_app#13" - , AApp (AId "anf_app#12", [ AInt 2 ]) + ( "anf_app_13" + , AApp (AId "anf_app_12", [ AInt 2 ]) , ALet - ( "anf_app#14" - , AApp (AId "anf_app#13", [ AInt 3 ]) + ( "anf_app_14" + , AApp (AId "anf_app_13", [ AInt 3 ]) , ALet ( "g" - , CImmExpr (AId "anf_app#14") + , CImmExpr (AId "anf_app_14") , ALet - ( "anf_op#15" + ( "anf_op_15" , AAdd (AInt 1, AInt 0) , ALet - ( "anf_app#16" - , AApp (AId "g", [ AId "anf_op#15" ]) + ( "anf_app_16" + , AApp (AId "g", [ AId "anf_op_15" ]) , ALet - ( "anf_app#17" - , AApp (AId "anf_app#16", [ AId "a" ]) - , ACExpr (CImmExpr (AId "anf_app#17")) + ( "anf_app_17" + , AApp (AId "anf_app_16", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app_17")) ) ) ) ) ) ) ) ) ) ) ) ) ] ;; @@ -606,42 +606,42 @@ let anf5 = [ AFun ( "g" , [ "a"; "b" ] - , ALet ("anf_op#1", ADiv (AId "a", AId "b"), ACExpr (CImmExpr (AId "anf_op#1"))) ) + , ALet ("anf_op_1", ADiv (AId "a", AId "b"), ACExpr (CImmExpr (AId "anf_op_1"))) ) ; AFun ( "h" , [ "a"; "c" ] - , ALet ("anf_op#2", AMul (AId "a", AId "c"), ACExpr (CImmExpr (AId "anf_op#2"))) ) + , ALet ("anf_op_2", AMul (AId "a", AId "c"), ACExpr (CImmExpr (AId "anf_op_2"))) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_op#3" + ( "anf_op_3" , ADiv (AId "a", AId "b") , ALet ( "g" - , CImmExpr (AId "anf_op#3") + , CImmExpr (AId "anf_op_3") , ALet - ( "anf_op#4" + ( "anf_op_4" , AMul (AId "a", AId "c") , ALet ( "h" - , CImmExpr (AId "anf_op#4") + , CImmExpr (AId "anf_op_4") , ALet - ( "anf_app#5" + ( "anf_app_5" , AApp (AId "h", [ AId "a" ]) , ALet - ( "anf_app#6" - , AApp (AId "anf_app#5", [ AInt 1 ]) + ( "anf_app_6" + , AApp (AId "anf_app_5", [ AInt 1 ]) , ALet - ( "anf_app#7" + ( "anf_app_7" , AApp (AId "g", [ AId "a" ]) , ALet - ( "anf_app#8" - , AApp (AId "anf_app#7", [ AInt 2 ]) + ( "anf_app_8" + , AApp (AId "anf_app_7", [ AInt 2 ]) , ALet - ( "anf_op#9" - , AAdd (AId "anf_app#6", AId "anf_app#8") - , ACExpr (CImmExpr (AId "anf_op#9")) ) ) ) ) ) + ( "anf_op_9" + , AAdd (AId "anf_app_6", AId "anf_app_8") + , ACExpr (CImmExpr (AId "anf_op_9")) ) ) ) ) ) ) ) ) ) ) ] ;; @@ -649,56 +649,56 @@ let anf5 = let%test _ = anf_ok "anf_5" ll5 anf5 let anf6 = - [ AFun ("anon$1", [ "a"; "x" ], ACExpr (CImmExpr (AId "x"))) + [ AFun ("anon_1", [ "a"; "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun ( "g" , [ "a" ] , ALet - ( "anf_app#1" - , AApp (AId "anon$1", [ AId "a" ]) - , ACExpr (CImmExpr (AId "anf_app#1")) ) ) + ( "anf_app_1" + , AApp (AId "anon_1", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app_1")) ) ) ; AFun - ( "anon$2" + ( "anon_2" , [ "a"; "x" ] - , ALet ("anf_op#2", AMul (AId "a", AId "x"), ACExpr (CImmExpr (AId "anf_op#2"))) ) + , ALet ("anf_op_2", AMul (AId "a", AId "x"), ACExpr (CImmExpr (AId "anf_op_2"))) ) ; AFun ( "h" , [ "a" ] , ALet - ( "anf_app#3" - , AApp (AId "anon$2", [ AId "a" ]) - , ACExpr (CImmExpr (AId "anf_app#3")) ) ) + ( "anf_app_3" + , AApp (AId "anon_2", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app_3")) ) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_app#4" - , AApp (AId "anon$1", [ AId "a" ]) + ( "anf_app_4" + , AApp (AId "anon_1", [ AId "a" ]) , ALet ( "g" - , CImmExpr (AId "anf_app#4") + , CImmExpr (AId "anf_app_4") , ALet - ( "anf_app#5" - , AApp (AId "anon$2", [ AId "a" ]) + ( "anf_app_5" + , AApp (AId "anon_2", [ AId "a" ]) , ALet ( "h" - , CImmExpr (AId "anf_app#5") + , CImmExpr (AId "anf_app_5") , ALet - ( "anf_app#6" + ( "anf_app_6" , AApp (AId "g", [ AId "a" ]) , ALet - ( "anf_app#7" - , AApp (AId "anf_app#6", [ AId "a" ]) + ( "anf_app_7" + , AApp (AId "anf_app_6", [ AId "a" ]) , ALet - ( "anf_app#8" + ( "anf_app_8" , AApp (AId "h", [ AId "a" ]) , ALet - ( "anf_app#9" - , AApp (AId "anf_app#8", [ AId "a" ]) + ( "anf_app_9" + , AApp (AId "anf_app_8", [ AId "a" ]) , ALet - ( "anf_op#10" - , AAdd (AId "anf_app#7", AId "anf_app#9") - , ACExpr (CImmExpr (AId "anf_op#10")) ) ) ) ) ) + ( "anf_op_10" + , AAdd (AId "anf_app_7", AId "anf_app_9") + , ACExpr (CImmExpr (AId "anf_op_10")) ) ) ) ) ) ) ) ) ) ) ] ;; diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 03f72f54f..18d7d25b4 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -6,66 +6,65 @@ > in fack n (fun x -> x) > ;; > EOF - (fun anon$1(n k n m)-> - (let anf_op#1=(k*m) + let anon_1 n k n m= + let anf_op_1=(k*m) in - (let anf_op#2=(anf_op#1*n) + let anf_op_2=(anf_op_1*n) in - anf_op#2)) - ) - (fun fack(n k)-> - (let anf_op#3=(n<=1) + anf_op_2 + + let fack n k= + let anf_op_3=(n<=1) in - (let anf_if#4=if (anf_op#3) + let anf_if_4=if (anf_op_3) then ( - (let anf_op#5=(n-1) + let anf_op_5=(n-1) in - (let anf_app#6=(n anf_op#5) + let anf_app_6=(n anf_op_5) in - anf_app#6)) + anf_app_6 ) else ( - (let anf_app#7=(anon$1 n) + let anf_app_7=(anon_1 n) in - (let anf_app#8=(anf_app#7 k) + let anf_app_8=(anf_app_7 k) in - (let anf_app#9=(anf_app#8 n) + let anf_app_9=(anf_app_8 n) in - anf_app#9)))) + anf_app_9) in - anf_if#4)) - ) - (fun anon$2(n x)-> + anf_if_4 + + let anon_2 n x= x - ) - (fun fac(n)-> - (let anf_op#10=(n<=1) + + let fac n= + let anf_op_10=(n<=1) in - (let anf_if#11=if (anf_op#10) + let anf_if_11=if (anf_op_10) then ( - (let anf_op#12=(n-1) + let anf_op_12=(n-1) in - (let anf_app#13=(n anf_op#12) + let anf_app_13=(n anf_op_12) in - anf_app#13)) + anf_app_13 ) else ( - (let anf_app#14=(anon$1 n) + let anf_app_14=(anon_1 n) in - (let anf_app#15=(anf_app#14 k) + let anf_app_15=(anf_app_14 k) in - (let anf_app#16=(anf_app#15 n) + let anf_app_16=(anf_app_15 n) in - anf_app#16)))) + anf_app_16) in - (let fack=anf_if#11 + let fack=anf_if_11 in - (let anf_app#17=(fack n) + let anf_app_17=(fack n) in - (let anf_app#18=(anon$2 n) + let anf_app_18=(anon_2 n) in - (let anf_app#19=(anf_app#17 anf_app#18) + let anf_app_19=(anf_app_17 anf_app_18) in - anf_app#19)))))) - ) + anf_app_19 $ dune exec anf_conv_test << EOF > let f a= > let g c d = @@ -74,61 +73,60 @@ > g 2 3 > ;; > EOF - (fun h(c d a e)-> - (let anf_op#1=(d*e) + let h c d a e= + let anf_op_1=(d*e) in - (let anf_op#2=(c+anf_op#1) + let anf_op_2=(c+anf_op_1) in - (let anf_op#3=(a*anf_op#2) + let anf_op_3=(a*anf_op_2) in - anf_op#3))) - ) - (fun g(a c d)-> - (let anf_op#4=(d*e) + anf_op_3 + + let g a c d= + let anf_op_4=(d*e) in - (let anf_op#5=(c+anf_op#4) + let anf_op_5=(c+anf_op_4) in - (let anf_op#6=(a*anf_op#5) + let anf_op_6=(a*anf_op_5) in - (let h=anf_op#6 + let h=anf_op_6 in - (let anf_app#7=(h c) + let anf_app_7=(h c) in - (let anf_app#8=(anf_app#7 d) + let anf_app_8=(anf_app_7 d) in - (let anf_app#9=(anf_app#8 a) + let anf_app_9=(anf_app_8 a) in - (let anf_app#10=(anf_app#9 4) + let anf_app_10=(anf_app_9 4) in - anf_app#10)))))))) - ) - (fun f(a)-> - (let anf_op#11=(d*e) + anf_app_10 + + let f a= + let anf_op_11=(d*e) in - (let anf_op#12=(c+anf_op#11) + let anf_op_12=(c+anf_op_11) in - (let anf_op#13=(a*anf_op#12) + let anf_op_13=(a*anf_op_12) in - (let h=anf_op#13 + let h=anf_op_13 in - (let anf_app#14=(h c) + let anf_app_14=(h c) in - (let anf_app#15=(anf_app#14 d) + let anf_app_15=(anf_app_14 d) in - (let anf_app#16=(anf_app#15 a) + let anf_app_16=(anf_app_15 a) in - (let anf_app#17=(anf_app#16 4) + let anf_app_17=(anf_app_16 4) in - (let g=anf_app#17 + let g=anf_app_17 in - (let anf_app#18=(g a) + let anf_app_18=(g a) in - (let anf_app#19=(anf_app#18 2) + let anf_app_19=(anf_app_18 2) in - (let anf_app#20=(anf_app#19 3) + let anf_app_20=(anf_app_19 3) in - anf_app#20)))))))))))) - ) + anf_app_20 $ dune exec anf_conv_test << EOF > let f a b = > let g c = @@ -137,70 +135,69 @@ > g 3 > ;; > EOF - (fun anon$1(c a b x)-> - (let anf_op#1=(c*b) + let anon_1 c a b x= + let anf_op_1=(c*b) in - (let anf_app#2=(a anf_op#1) + let anf_app_2=(a anf_op_1) in - (let anf_op#3=(x*anf_app#2) + let anf_op_3=(x*anf_app_2) in - anf_op#3))) - ) - (fun h(c a b)-> - (let anf_app#4=(anon$1 c) + anf_op_3 + + let h c a b= + let anf_app_4=(anon_1 c) in - (let anf_app#5=(anf_app#4 a) + let anf_app_5=(anf_app_4 a) in - (let anf_app#6=(anf_app#5 b) + let anf_app_6=(anf_app_5 b) in - anf_app#6))) - ) - (fun g(a b c)-> - (let anf_app#7=(anon$1 c) + anf_app_6 + + let g a b c= + let anf_app_7=(anon_1 c) in - (let anf_app#8=(anf_app#7 a) + let anf_app_8=(anf_app_7 a) in - (let anf_app#9=(anf_app#8 b) + let anf_app_9=(anf_app_8 b) in - (let h=anf_app#9 + let h=anf_app_9 in - (let anf_app#10=(h c) + let anf_app_10=(h c) in - (let anf_app#11=(anf_app#10 a) + let anf_app_11=(anf_app_10 a) in - (let anf_app#12=(anf_app#11 b) + let anf_app_12=(anf_app_11 b) in - (let anf_app#13=(anf_app#12 a) + let anf_app_13=(anf_app_12 a) in - anf_app#13)))))))) - ) - (fun f(a b)-> - (let anf_app#14=(anon$1 c) + anf_app_13 + + let f a b= + let anf_app_14=(anon_1 c) in - (let anf_app#15=(anf_app#14 a) + let anf_app_15=(anf_app_14 a) in - (let anf_app#16=(anf_app#15 b) + let anf_app_16=(anf_app_15 b) in - (let h=anf_app#16 + let h=anf_app_16 in - (let anf_app#17=(h c) + let anf_app_17=(h c) in - (let anf_app#18=(anf_app#17 a) + let anf_app_18=(anf_app_17 a) in - (let anf_app#19=(anf_app#18 b) + let anf_app_19=(anf_app_18 b) in - (let anf_app#20=(anf_app#19 a) + let anf_app_20=(anf_app_19 a) in - (let g=anf_app#20 + let g=anf_app_20 in - (let anf_app#21=(g a) + let anf_app_21=(g a) in - (let anf_app#22=(anf_app#21 b) + let anf_app_22=(anf_app_21 b) in - (let anf_app#23=(anf_app#22 3) + let anf_app_23=(anf_app_22 3) in - anf_app#23)))))))))))) - ) + anf_app_23 $ dune exec anf_conv_test << EOF > let f a = > let g a b= @@ -209,55 +206,54 @@ > g (1+0) a > ;; > EOF - (fun h(a a b c)-> - (let anf_op#1=(b/c) + let h a a b c= + let anf_op_1=(b/c) in - (let anf_op#2=(a*anf_op#1) + let anf_op_2=(a*anf_op_1) in - anf_op#2)) - ) - (fun g(a b)-> - (let anf_op#3=(b/c) + anf_op_2 + + let g a b= + let anf_op_3=(b/c) in - (let anf_op#4=(a*anf_op#3) + let anf_op_4=(a*anf_op_3) in - (let h=anf_op#4 + let h=anf_op_4 in - (let anf_app#5=(h a) + let anf_app_5=(h a) in - (let anf_app#6=(anf_app#5 a) + let anf_app_6=(anf_app_5 a) in - (let anf_app#7=(anf_app#6 2) + let anf_app_7=(anf_app_6 2) in - (let anf_app#8=(anf_app#7 3) + let anf_app_8=(anf_app_7 3) in - anf_app#8))))))) - ) - (fun f(a)-> - (let anf_op#9=(b/c) + anf_app_8 + + let f a= + let anf_op_9=(b/c) in - (let anf_op#10=(a*anf_op#9) + let anf_op_10=(a*anf_op_9) in - (let h=anf_op#10 + let h=anf_op_10 in - (let anf_app#11=(h a) + let anf_app_11=(h a) in - (let anf_app#12=(anf_app#11 a) + let anf_app_12=(anf_app_11 a) in - (let anf_app#13=(anf_app#12 2) + let anf_app_13=(anf_app_12 2) in - (let anf_app#14=(anf_app#13 3) + let anf_app_14=(anf_app_13 3) in - (let g=anf_app#14 + let g=anf_app_14 in - (let anf_op#15=(1+0) + let anf_op_15=(1+0) in - (let anf_app#16=(g anf_op#15) + let anf_app_16=(g anf_op_15) in - (let anf_app#17=(anf_app#16 a) + let anf_app_17=(anf_app_16 a) in - anf_app#17))))))))))) - ) + anf_app_17 $ dune exec anf_conv_test << EOF > let f a = > let g b = a / b in @@ -265,37 +261,36 @@ > ((h 1) + (g 2)) > ;; > EOF - (fun g(a b)-> - (let anf_op#1=(a/b) + let g a b= + let anf_op_1=(a/b) in - anf_op#1) - ) - (fun h(a c)-> - (let anf_op#2=(a*c) + anf_op_1 + + let h a c= + let anf_op_2=(a*c) in - anf_op#2) - ) - (fun f(a)-> - (let anf_op#3=(a/b) + anf_op_2 + + let f a= + let anf_op_3=(a/b) in - (let g=anf_op#3 + let g=anf_op_3 in - (let anf_op#4=(a*c) + let anf_op_4=(a*c) in - (let h=anf_op#4 + let h=anf_op_4 in - (let anf_app#5=(h a) + let anf_app_5=(h a) in - (let anf_app#6=(anf_app#5 1) + let anf_app_6=(anf_app_5 1) in - (let anf_app#7=(g a) + let anf_app_7=(g a) in - (let anf_app#8=(anf_app#7 2) + let anf_app_8=(anf_app_7 2) in - (let anf_op#9=(anf_app#6+anf_app#8) + let anf_op_9=(anf_app_6+anf_app_8) in - anf_op#9))))))))) - ) + anf_op_9 $ dune exec anf_conv_test << EOF > let f a = > let g = (fun x -> x) in @@ -303,163 +298,160 @@ > ((g a) + (h a)) > ;; > EOF - (fun anon$1(a x)-> + let anon_1 a x= x - ) - (fun g(a)-> - (let anf_app#1=(anon$1 a) + + let g a= + let anf_app_1=(anon_1 a) in - anf_app#1) - ) - (fun anon$2(a x)-> - (let anf_op#2=(a*x) + anf_app_1 + + let anon_2 a x= + let anf_op_2=(a*x) in - anf_op#2) - ) - (fun h(a)-> - (let anf_app#3=(anon$2 a) + anf_op_2 + + let h a= + let anf_app_3=(anon_2 a) in - anf_app#3) - ) - (fun f(a)-> - (let anf_app#4=(anon$1 a) + anf_app_3 + + let f a= + let anf_app_4=(anon_1 a) in - (let g=anf_app#4 + let g=anf_app_4 in - (let anf_app#5=(anon$2 a) + let anf_app_5=(anon_2 a) in - (let h=anf_app#5 + let h=anf_app_5 in - (let anf_app#6=(g a) + let anf_app_6=(g a) in - (let anf_app#7=(anf_app#6 a) + let anf_app_7=(anf_app_6 a) in - (let anf_app#8=(h a) + let anf_app_8=(h a) in - (let anf_app#9=(anf_app#8 a) + let anf_app_9=(anf_app_8 a) in - (let anf_op#10=(anf_app#7+anf_app#9) + let anf_op_10=(anf_app_7+anf_app_9) in - anf_op#10))))))))) - ) + anf_op_10 $ 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 n x)-> - (let anf_app#1=(f n) + let anon_1 n f n x= + let anf_app_1=(f n) in - (let anf_op#2=(x*anf_app#1) + let anf_op_2=(x*anf_app_1) in - anf_op#2)) - ) - (fun fack(n f)-> - (let anf_op#3=(n<=1) + anf_op_2 + + let fack n f= + let anf_op_3=(n<=1) in - (let anf_if#4=if (anf_op#3) + let anf_if_4=if (anf_op_3) then ( - (let anf_app#5=(f 1) + let anf_app_5=(f 1) in - anf_app#5) + anf_app_5 ) else ( - (let anf_op#6=(n-1) + let anf_op_6=(n-1) in - (let anf_app#7=(fack anf_op#6) + let anf_app_7=(fack anf_op_6) in - (let anf_app#8=(anon$1 n) + let anf_app_8=(anon_1 n) in - (let anf_app#9=(anf_app#8 f) + let anf_app_9=(anf_app_8 f) in - (let anf_app#10=(anf_app#9 n) + let anf_app_10=(anf_app_9 n) in - (let anf_app#11=(anf_app#7 anf_app#10) + let anf_app_11=(anf_app_7 anf_app_10) in - anf_app#11))))))) + anf_app_11) in - anf_if#4)) - ) - (fun anon$2(n x)-> + anf_if_4 + + let anon_2 n x= x - ) - (fun fac(n)-> - (let anf_op#12=(n<=1) + + let fac n= + let anf_op_12=(n<=1) in - (let anf_if#13=if (anf_op#12) + let anf_if_13=if (anf_op_12) then ( - (let anf_app#14=(f 1) + let anf_app_14=(f 1) in - anf_app#14) + anf_app_14 ) else ( - (let anf_op#15=(n-1) + let anf_op_15=(n-1) in - (let anf_app#16=(fack anf_op#15) + let anf_app_16=(fack anf_op_15) in - (let anf_app#17=(anon$1 n) + let anf_app_17=(anon_1 n) in - (let anf_app#18=(anf_app#17 f) + let anf_app_18=(anf_app_17 f) in - (let anf_app#19=(anf_app#18 n) + let anf_app_19=(anf_app_18 n) in - (let anf_app#20=(anf_app#16 anf_app#19) + let anf_app_20=(anf_app_16 anf_app_19) in - anf_app#20))))))) + anf_app_20) in - (let fack=anf_if#13 + let fack=anf_if_13 in - (let anf_app#21=(fack n) + let anf_app_21=(fack n) in - (let anf_app#22=(anon$2 n) + let anf_app_22=(anon_2 n) in - (let anf_app#23=(anf_app#21 anf_app#22) + let anf_app_23=(anf_app_21 anf_app_22) in - anf_app#23)))))) - ) + 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) + let fack n= + let anf_op_1=(n<1) in - (let anf_if#2=if (anf_op#1) + let anf_if_2=if (anf_op_1) then ( n ) else ( - (let anf_op#3=(n-1) + let anf_op_3=(n-1) in - (let anf_app#4=(fack anf_op#3) + let anf_app_4=(fack anf_op_3) in - (let anf_op#5=(n*anf_app#4) + let anf_op_5=(n*anf_app_4) in - anf_op#5)))) + anf_op_5) in - anf_if#2)) - ) - (fun fac(n)-> - (let anf_op#6=(n<1) + anf_if_2 + + let fac n= + let anf_op_6=(n<1) in - (let anf_if#7=if (anf_op#6) + let anf_if_7=if (anf_op_6) then ( n ) else ( - (let anf_op#8=(n-1) + let anf_op_8=(n-1) in - (let anf_app#9=(fack anf_op#8) + let anf_app_9=(fack anf_op_8) in - (let anf_op#10=(n*anf_app#9) + let anf_op_10=(n*anf_app_9) in - anf_op#10)))) + anf_op_10) in - (let fack=anf_if#7 + let fack=anf_if_7 in - (let anf_app#11=(fack n) + let anf_app_11=(fack n) in - anf_app#11)))) - ) + anf_app_11 $ dune exec anf_conv_test << EOF > let f a = > let g c d = @@ -468,565 +460,553 @@ > in > (g 2 3) > EOF - (fun h(c d a e)-> - (let anf_op#1=(d*e) + let h c d a e= + let anf_op_1=(d*e) in - (let anf_op#2=(c+anf_op#1) + let anf_op_2=(c+anf_op_1) in - (let anf_op#3=(a*anf_op#2) + let anf_op_3=(a*anf_op_2) in - anf_op#3))) - ) - (fun g(a c d)-> - (let anf_op#4=(d*e) + anf_op_3 + + let g a c d= + let anf_op_4=(d*e) in - (let anf_op#5=(c+anf_op#4) + let anf_op_5=(c+anf_op_4) in - (let anf_op#6=(a*anf_op#5) + let anf_op_6=(a*anf_op_5) in - (let h=anf_op#6 + let h=anf_op_6 in - (let anf_app#7=(h c) + let anf_app_7=(h c) in - (let anf_app#8=(anf_app#7 d) + let anf_app_8=(anf_app_7 d) in - (let anf_app#9=(anf_app#8 a) + let anf_app_9=(anf_app_8 a) in - (let anf_app#10=(anf_app#9 4) + let anf_app_10=(anf_app_9 4) in - anf_app#10)))))))) - ) - (fun f(a)-> - (let anf_op#11=(d*e) + anf_app_10 + + let f a= + let anf_op_11=(d*e) in - (let anf_op#12=(c+anf_op#11) + let anf_op_12=(c+anf_op_11) in - (let anf_op#13=(a*anf_op#12) + let anf_op_13=(a*anf_op_12) in - (let h=anf_op#13 + let h=anf_op_13 in - (let anf_app#14=(h c) + let anf_app_14=(h c) in - (let anf_app#15=(anf_app#14 d) + let anf_app_15=(anf_app_14 d) in - (let anf_app#16=(anf_app#15 a) + let anf_app_16=(anf_app_15 a) in - (let anf_app#17=(anf_app#16 4) + let anf_app_17=(anf_app_16 4) in - (let g=anf_app#17 + let g=anf_app_17 in - (let anf_app#18=(g a) + let anf_app_18=(g a) in - (let anf_app#19=(anf_app#18 2) + let anf_app_19=(anf_app_18 2) in - (let anf_app#20=(anf_app#19 3) + let anf_app_20=(anf_app_19 3) in - anf_app#20)))))))))))) - ) + anf_app_20 $ dune exec anf_conv_test < manytests/do_not_type/001.ml Id fac not found in env - (fun recfac(n)-> - (let anf_op#1=(n<=1) + let recfac n= + let anf_op_1=(n<=1) in - (let anf_if#2=if (anf_op#1) + let anf_if_2=if (anf_op_1) then ( 1 ) else ( - (let anf_op#3=(n-1) + let anf_op_3=(n-1) in - (let anf_app#4=(fac anf_op#3) + let anf_app_4=(fac anf_op_3) in - (let anf_op#5=(n*anf_app#4) + let anf_op_5=(n*anf_app_4) in - anf_op#5)))) + anf_op_5) in - anf_if#2)) - ) + anf_if_2 $ dune exec anf_conv_test < manytests/do_not_type/002if.ml - (fun main()-> - (let anf_if#1=if (true) + let main = + let anf_if_1=if (true) then ( 1 ) else ( false) in - anf_if#1) - ) + anf_if_1 $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml Id f not found in env - (fun anon$2(x f)-> - (let anf_app#1=(x x) + let anon_2 x f= + let anf_app_1=(x x) in - (let anf_app#2=(anf_app#1 f) + let anf_app_2=(anf_app_1 f) in - anf_app#2)) - ) - (fun anon$1(f x)-> - (let anf_app#3=(anon$2 x) + anf_app_2 + + let anon_1 f x= + let anf_app_3=(anon_2 x) in - (let anf_app#4=(anf_app#3 f) + let anf_app_4=(anf_app_3 f) in - (let anf_app#5=(f anf_app#4) + let anf_app_5=(f anf_app_4) in - anf_app#5))) - ) - (fun fix(f)-> - (let anf_app#6=(anon$1 f) + anf_app_5 + + let fix f= + let anf_app_6=(anon_1 f) in - anf_app#6) - ) - (fun anon$4(x f)-> - (let anf_app#7=(x x) + anf_app_6 + + let anon_4 x f= + let anf_app_7=(x x) in - (let anf_app#8=(anf_app#7 f) + let anf_app_8=(anf_app_7 f) in - anf_app#8)) - ) - (fun anon$3(x)-> - (let anf_app#9=(anon$4 x) + anf_app_8 + + let anon_3 x= + let anf_app_9=(anon_4 x) in - (let anf_app#10=(f anf_app#9) + let anf_app_10=(f anf_app_9) in - anf_app#10)) - ) + anf_app_10 $ dune exec anf_conv_test < manytests/typed/001fac.ml - (fun fac(n)-> - (let anf_op#1=(n<=1) + let fac n= + let anf_op_1=(n<=1) in - (let anf_if#2=if (anf_op#1) + let anf_if_2=if (anf_op_1) then ( 1 ) else ( - (let anf_op#3=(n-1) + let anf_op_3=(n-1) in - (let anf_app#4=(fac anf_op#3) + let anf_app_4=(fac anf_op_3) in - (let anf_op#5=(n*anf_app#4) + let anf_op_5=(n*anf_app_4) in - anf_op#5)))) + anf_op_5) in - anf_if#2)) - ) - (fun main()-> - (let anf_app#6=(fac 4) + anf_if_2 + + let main = + let anf_app_6=(fac 4) in - (let anf_app#7=(print_int anf_app#6) + let anf_app_7=(print_int anf_app_6) in - (let ()=anf_app#7 + let ()=anf_app_7 in - 0))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/002fac.ml - (fun anon$1(n k p)-> - (let anf_op#1=(p*n) + let anon_1 n k p= + let anf_op_1=(p*n) in - (let anf_app#2=(k anf_op#1) + let anf_app_2=(k anf_op_1) in - anf_app#2)) - ) - (fun fac_cps(n k)-> - (let anf_op#3=(n=1) + anf_app_2 + + let fac_cps n k= + let anf_op_3=(n=1) in - (let anf_if#4=if (anf_op#3) + let anf_if_4=if (anf_op_3) then ( - (let anf_app#5=(k 1) + let anf_app_5=(k 1) in - anf_app#5) + anf_app_5 ) else ( - (let anf_op#6=(n-1) + let anf_op_6=(n-1) in - (let anf_app#7=(fac_cps anf_op#6) + let anf_app_7=(fac_cps anf_op_6) in - (let anf_app#8=(anon$1 n) + let anf_app_8=(anon_1 n) in - (let anf_app#9=(anf_app#8 k) + let anf_app_9=(anf_app_8 k) in - (let anf_app#10=(anf_app#7 anf_app#9) + let anf_app_10=(anf_app_7 anf_app_9) in - anf_app#10)))))) + anf_app_10) in - anf_if#4)) - ) - (fun anon$2(print_int)-> + anf_if_4 + + let anon_2 print_int= print_int - ) - (fun main()-> - (let anf_app#11=(fac_cps 4) + + let main = + let anf_app_11=(fac_cps 4) in - (let anf_app#12=(anon$2 ) + let anf_app_12=(anon_2 ) in - (let anf_app#13=(anf_app#11 anf_app#12) + let anf_app_13=(anf_app_11 anf_app_12) in - (let anf_app#14=(print_int anf_app#13) + let anf_app_14=(print_int anf_app_13) in - (let ()=anf_app#14 + let ()=anf_app_14 in - 0))))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/003fib.ml - (fun n1(a b n)-> - (let anf_op#1=(n-1) + let n1 a b n= + let anf_op_1=(n-1) in - anf_op#1) - ) - (fun ab(a b n)-> - (let anf_op#2=(a+b) + anf_op_1 + + let ab a b n= + let anf_op_2=(a+b) in - anf_op#2) - ) - (fun fib_acc(a b n)-> - (let anf_op#3=(n=1) + anf_op_2 + + let fib_acc a b n= + let anf_op_3=(n=1) in - (let anf_if#4=if (anf_op#3) + let anf_if_4=if (anf_op_3) then ( b ) else ( - (let anf_op#5=(n-1) + let anf_op_5=(n-1) in - (let n1=anf_op#5 + let n1=anf_op_5 in - (let anf_op#6=(a+b) + let anf_op_6=(a+b) in - (let ab=anf_op#6 + let ab=anf_op_6 in - (let anf_app#7=(fib_acc b) + let anf_app_7=(fib_acc b) in - (let anf_app#8=(ab a) + let anf_app_8=(ab a) in - (let anf_app#9=(anf_app#8 b) + let anf_app_9=(anf_app_8 b) in - (let anf_app#10=(anf_app#9 n) + let anf_app_10=(anf_app_9 n) in - (let anf_app#11=(anf_app#7 anf_app#10) + let anf_app_11=(anf_app_7 anf_app_10) in - (let anf_app#12=(n1 a) + let anf_app_12=(n1 a) in - (let anf_app#13=(anf_app#12 b) + let anf_app_13=(anf_app_12 b) in - (let anf_app#14=(anf_app#13 n) + let anf_app_14=(anf_app_13 n) in - (let anf_app#15=(anf_app#11 anf_app#14) + let anf_app_15=(anf_app_11 anf_app_14) in - anf_app#15)))))))))))))) + anf_app_15) in - anf_if#4)) - ) - (fun fib(n)-> - (let anf_op#16=(n<2) + anf_if_4 + + let fib n= + let anf_op_16=(n<2) in - (let anf_if#17=if (anf_op#16) + let anf_if_17=if (anf_op_16) then ( n ) else ( - (let anf_op#18=(n-1) + let anf_op_18=(n-1) in - (let anf_op#19=(n-2) + let anf_op_19=(n-2) in - (let anf_app#20=(fib anf_op#19) + let anf_app_20=(fib anf_op_19) in - (let anf_op#21=(anf_op#18+anf_app#20) + let anf_op_21=(anf_op_18+anf_app_20) in - (let anf_app#22=(fib anf_op#21) + let anf_app_22=(fib anf_op_21) in - anf_app#22)))))) + anf_app_22) in - anf_if#17)) - ) - (fun main()-> - (let anf_app#23=(fib_acc 0) + anf_if_17 + + let main = + let anf_app_23=(fib_acc 0) in - (let anf_app#24=(anf_app#23 1) + let anf_app_24=(anf_app_23 1) in - (let anf_app#25=(anf_app#24 4) + let anf_app_25=(anf_app_24 4) in - (let anf_app#26=(print_int anf_app#25) + let anf_app_26=(print_int anf_app_25) in - (let ()=anf_app#26 + let ()=anf_app_26 in - (let anf_app#27=(fib 4) + let anf_app_27=(fib 4) in - (let anf_app#28=(print_int anf_app#27) + let anf_app_28=(print_int anf_app_27) in - (let ()=anf_app#28 + let ()=anf_app_28 in - 0)))))))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/004manyargs.ml - (fun wrap(f)-> - (let anf_op#1=(1=1) + let wrap f= + let anf_op_1=(1=1) in - (let anf_if#2=if (anf_op#1) + let anf_if_2=if (anf_op_1) then ( f ) else ( f) in - anf_if#2)) - ) - (fun a_0(a b c)-> - (let anf_app#3=(print_int a) + anf_if_2 + + let a_0 a b c= + let anf_app_3=(print_int a) in - anf_app#3) - ) - (fun b_0(a b c)-> - (let anf_app#4=(print_int b) + anf_app_3 + + let b_0 a b c= + let anf_app_4=(print_int b) in - anf_app#4) - ) - (fun c_0(a b c)-> - (let anf_app#5=(print_int c) + anf_app_4 + + let c_0 a b c= + let anf_app_5=(print_int c) in - anf_app#5) - ) - (fun test3(a b c)-> - (let anf_app#6=(print_int a) + anf_app_5 + + let test3 a b c= + let anf_app_6=(print_int a) in - (let a_0=anf_app#6 + let a_0=anf_app_6 in - (let anf_app#7=(print_int b) + let anf_app_7=(print_int b) in - (let b_0=anf_app#7 + let b_0=anf_app_7 in - (let anf_app#8=(print_int c) + let anf_app_8=(print_int c) in - (let c_0=anf_app#8 + let c_0=anf_app_8 in - 0)))))) - ) - (fun test10(a b c d e f g h i j)-> - (let anf_op#9=(a+b) + 0 + + let test10 a b c d e f g h i j= + let anf_op_9=(a+b) in - (let anf_op#10=(anf_op#9+c) + let anf_op_10=(anf_op_9+c) in - (let anf_op#11=(anf_op#10+d) + let anf_op_11=(anf_op_10+d) in - (let anf_op#12=(anf_op#11+e) + let anf_op_12=(anf_op_11+e) in - (let anf_op#13=(anf_op#12+f) + let anf_op_13=(anf_op_12+f) in - (let anf_op#14=(anf_op#13+g) + let anf_op_14=(anf_op_13+g) in - (let anf_op#15=(anf_op#14+h) + let anf_op_15=(anf_op_14+h) in - (let anf_op#16=(anf_op#15+i) + let anf_op_16=(anf_op_15+i) in - (let anf_op#17=(anf_op#16+j) + let anf_op_17=(anf_op_16+j) in - anf_op#17))))))))) - ) - (fun main()-> - (let anf_app#18=(test10 ) + anf_op_17 + + let main = + let anf_app_18=(test10 ) in - (let anf_app#19=(wrap anf_app#18) + let anf_app_19=(wrap anf_app_18) in - (let anf_app#20=(anf_app#19 1) + let anf_app_20=(anf_app_19 1) in - (let anf_app#21=(anf_app#20 10) + let anf_app_21=(anf_app_20 10) in - (let anf_app#22=(anf_app#21 100) + let anf_app_22=(anf_app_21 100) in - (let anf_app#23=(anf_app#22 1000) + let anf_app_23=(anf_app_22 1000) in - (let anf_app#24=(anf_app#23 10000) + let anf_app_24=(anf_app_23 10000) in - (let anf_app#25=(anf_app#24 100000) + let anf_app_25=(anf_app_24 100000) in - (let anf_app#26=(anf_app#25 1000000) + let anf_app_26=(anf_app_25 1000000) in - (let anf_app#27=(anf_app#26 10000000) + let anf_app_27=(anf_app_26 10000000) in - (let anf_app#28=(anf_app#27 100000000) + let anf_app_28=(anf_app_27 100000000) in - (let anf_app#29=(anf_app#28 1000000000) + let anf_app_29=(anf_app_28 1000000000) in - (let rez=anf_app#29 + let rez=anf_app_29 in - (let anf_app#30=(print_int rez) + let anf_app_30=(print_int rez) in - (let ()=anf_app#30 + let ()=anf_app_30 in - (let anf_app#31=(test3 ) + let anf_app_31=(test3 ) in - (let anf_app#32=(wrap anf_app#31) + let anf_app_32=(wrap anf_app_31) in - (let anf_app#33=(anf_app#32 1) + let anf_app_33=(anf_app_32 1) in - (let anf_app#34=(anf_app#33 10) + let anf_app_34=(anf_app_33 10) in - (let anf_app#35=(anf_app#34 100) + let anf_app_35=(anf_app_34 100) in - (let temp2=anf_app#35 + let temp2=anf_app_35 in - 0))))))))))))))))))))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/005fix.ml - (fun fix(f x)-> - (let anf_app#1=(fix f) + let fix f x= + let anf_app_1=(fix f) in - (let anf_app#2=(f anf_app#1) + let anf_app_2=(f anf_app_1) in - (let anf_app#3=(anf_app#2 x) + let anf_app_3=(anf_app_2 x) in - anf_app#3))) - ) - (fun fac(self n)-> - (let anf_op#4=(n<=1) + anf_app_3 + + let fac self n= + let anf_op_4=(n<=1) in - (let anf_if#5=if (anf_op#4) + let anf_if_5=if (anf_op_4) then ( 1 ) else ( - (let anf_op#6=(n-1) + let anf_op_6=(n-1) in - (let anf_app#7=(self anf_op#6) + let anf_app_7=(self anf_op_6) in - (let anf_op#8=(n*anf_app#7) + let anf_op_8=(n*anf_app_7) in - anf_op#8)))) + anf_op_8) in - anf_if#5)) - ) - (fun main()-> - (let anf_app#9=(fac ) + anf_if_5 + + let main = + let anf_app_9=(fac ) in - (let anf_app#10=(fix anf_app#9) + let anf_app_10=(fix anf_app_9) in - (let anf_app#11=(anf_app#10 6) + let anf_app_11=(anf_app_10 6) in - (let anf_app#12=(print_int anf_app#11) + let anf_app_12=(print_int anf_app_11) in - (let ()=anf_app#12 + let ()=anf_app_12 in - 0))))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/006partial.ml - (fun anon$1(b foo)-> - (let anf_op#1=(foo+2) - in - anf_op#1) - ) - (fun anon$2(b foo)-> - (let anf_op#2=(foo*10) - in - anf_op#2) - ) - (fun foo(b)-> - (let anf_if#3=if (b) + let anon_1 b foo= + let anf_op_1=(foo+2) + in + anf_op_1 + + let anon_2 b foo= + let anf_op_2=(foo*10) + in + anf_op_2 + + let foo b= + let anf_if_3=if (b) then ( - (let anf_app#4=(anon$1 b) + let anf_app_4=(anon_1 b) in - anf_app#4) + anf_app_4 ) else ( - (let anf_app#5=(anon$2 b) + let anf_app_5=(anon_2 b) in - anf_app#5)) + anf_app_5) in - anf_if#3) - ) - (fun foo_0(x)-> - (let anf_app#6=(foo true) + anf_if_3 + + let foo_0 x= + let anf_app_6=(foo true) in - (let anf_app#7=(foo false) + let anf_app_7=(foo false) in - (let anf_app#8=(foo true) + let anf_app_8=(foo true) in - (let anf_app#9=(foo false) + let anf_app_9=(foo false) in - (let anf_app#10=(anf_app#9 x) + let anf_app_10=(anf_app_9 x) in - (let anf_app#11=(anf_app#8 anf_app#10) + let anf_app_11=(anf_app_8 anf_app_10) in - (let anf_app#12=(anf_app#7 anf_app#11) + let anf_app_12=(anf_app_7 anf_app_11) in - (let anf_app#13=(anf_app#6 anf_app#12) + let anf_app_13=(anf_app_6 anf_app_12) in - anf_app#13)))))))) - ) - (fun main()-> - (let anf_app#14=(foo_0 11) + anf_app_13 + + let main = + let anf_app_14=(foo_0 11) in - (let anf_app#15=(print_int anf_app#14) + let anf_app_15=(print_int anf_app_14) in - (let ()=anf_app#15 + let ()=anf_app_15 in - 0))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/006partial2.ml - (fun foo(a b c)-> - (let anf_app#1=(print_int a) + let foo a b c= + let anf_app_1=(print_int a) in - (let ()=anf_app#1 + let ()=anf_app_1 in - (let anf_app#2=(print_int b) + let anf_app_2=(print_int b) in - (let ()=anf_app#2 + let ()=anf_app_2 in - (let anf_app#3=(print_int c) + let anf_app_3=(print_int c) in - (let ()=anf_app#3 + let ()=anf_app_3 in - (let anf_op#4=(b*c) + let anf_op_4=(b*c) in - (let anf_op#5=(a+anf_op#4) + let anf_op_5=(a+anf_op_4) in - anf_op#5)))))))) - ) - (fun main()-> - (let anf_app#6=(foo 1) + anf_op_5 + + let main = + let anf_app_6=(foo 1) in - (let foo_0=anf_app#6 + let foo_0=anf_app_6 in - (let anf_app#7=(foo_0 2) + let anf_app_7=(foo_0 2) in - (let foo_0_2=anf_app#7 + let foo_0_2=anf_app_7 in - (let anf_app#8=(foo_0_2 3) + let anf_app_8=(foo_0_2 3) in - (let foo_0_2_4=anf_app#8 + let foo_0_2_4=anf_app_8 in - (let anf_app#9=(print_int foo_0_2_4) + let anf_app_9=(print_int foo_0_2_4) in - (let ()=anf_app#9 + let ()=anf_app_9 in - 0)))))))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/006partial3.ml - (fun anon$2(b a c)-> - (let anf_app#1=(print_int c) + let anon_2 b a c= + let anf_app_1=(print_int c) in - anf_app#1) - ) - (fun anon$1(a b)-> - (let anf_app#2=(print_int b) + anf_app_1 + + let anon_1 a b= + let anf_app_2=(print_int b) in - (let ()=anf_app#2 + let ()=anf_app_2 in - (let anf_app#3=(anon$2 b) + let anf_app_3=(anon_2 b) in - (let anf_app#4=(anf_app#3 a) + let anf_app_4=(anf_app_3 a) in - anf_app#4)))) - ) - (fun foo(a)-> - (let anf_app#5=(print_int a) + anf_app_4 + + let foo a= + let anf_app_5=(print_int a) in - (let ()=anf_app#5 + let ()=anf_app_5 in - (let anf_app#6=(anon$1 a) + let anf_app_6=(anon_1 a) in - anf_app#6))) - ) - (fun main()-> - (let anf_app#7=(foo 4) + anf_app_6 + + let main = + let anf_app_7=(foo 4) in - (let anf_app#8=(anf_app#7 8) + let anf_app_8=(anf_app_7 8) in - (let anf_app#9=(anf_app#8 9) + let anf_app_9=(anf_app_8 9) in - (let ()=anf_app#9 + let ()=anf_app_9 in - 0)))) - ) + 0 $ dune exec anf_conv_test < manytests/typed/007order.ml : end_of_input $ dune exec anf_conv_test < manytests/typed/008ascription.ml diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 07faff6da..344c6373e 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -6,10 +6,10 @@ > in fack n (fun x -> x) > ;; > EOF - (fun anon$1(n k n m)->(((k*m)*n))) - (fun fack(n k)->(if ((n<=1)) then ({n (n-1)}) else ({{{anon$1 n} k} n}))) - (fun anon$2(n x)->(x)) - (fun fac(n)->(let fack = (if ((n<=1)) then ({n (n-1)}) else ({{{anon$1 n} k} n}) in {{fack n} {anon$2 n}}))) + (fun anon_1(n k n m)->(((k*m)*n))) + (fun fack(n k)->(if ((n<=1)) then ({n (n-1)}) else ({{{anon_1 n} k} n}))) + (fun anon_2(n x)->(x)) + (fun fac(n)->(let fack = (if ((n<=1)) then ({n (n-1)}) else ({{{anon_1 n} k} n}) in {{fack n} {anon_2 n}}))) $ dune exec lambda_lifting_test << EOF > let f a= > let g c d = @@ -29,10 +29,10 @@ > g 3 > ;; > EOF - (fun anon$1(c a b x)->((x*{a (c*b)}))) - (fun h(c a b)->({{{anon$1 c} a} b})) - (fun g(a b c)->(let h = ({{{anon$1 c} a} b} in {{{{h c} a} b} a}))) - (fun f(a b)->(let g = (let h = ({{{anon$1 c} a} b} in {{{{h c} a} b} a}) in {{{g a} b} 3}))) + (fun anon_1(c a b x)->((x*{a (c*b)}))) + (fun h(c a b)->({{{anon_1 c} a} b})) + (fun g(a b c)->(let h = ({{{anon_1 c} a} b} in {{{{h c} a} b} a}))) + (fun f(a b)->(let g = (let h = ({{{anon_1 c} a} b} in {{{{h c} a} b} a}) in {{{g a} b} 3}))) $ dune exec lambda_lifting_test << EOF > let f a = > let g a b= @@ -61,21 +61,21 @@ > ((g a) + (h a)) > ;; > EOF - (fun anon$1(a x)->(x)) - (fun g(a)->({anon$1 a})) - (fun anon$2(a x)->((a*x))) - (fun h(a)->({anon$2 a})) - (fun f(a)->(let g = ({anon$1 a} in let h = ({anon$2 a} in ({{g a} a}+{{h a} a}))))) + (fun anon_1(a x)->(x)) + (fun g(a)->({anon_1 a})) + (fun anon_2(a x)->((a*x))) + (fun h(a)->({anon_2 a})) + (fun f(a)->(let g = ({anon_1 a} in let h = ({anon_2 a} in ({{g a} a}+{{h a} a}))))) $ 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 n x)->((x*{f n}))) - (fun fack(n f)->(if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon$1 n} f} n}}))) - (fun anon$2(n x)->(x)) - (fun fac(n)->(let fack = (if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon$1 n} f} n}}) in {{fack n} {anon$2 n}}))) + (fun anon_1(n f n x)->((x*{f n}))) + (fun fack(n f)->(if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon_1 n} f} n}}))) + (fun anon_2(n x)->(x)) + (fun fac(n)->(let fack = (if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon_1 n} f} n}}) in {{fack n} {anon_2 n}}))) $ dune exec lambda_lifting_test << EOF > let fac n = > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in @@ -102,19 +102,19 @@ (fun main()->(if (true) then (1) else (false))) $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml Id f not found in env - (fun anon$2(x f)->({{x x} f})) - (fun anon$1(f x)->({f {{anon$2 x} f}})) - (fun fix(f)->({anon$1 f})) - (fun anon$4(x f)->({{x x} f})) - (fun anon$3(x)->({f {anon$4 x}})) + (fun anon_2(x f)->({{x x} f})) + (fun anon_1(f x)->({f {{anon_2 x} f}})) + (fun fix(f)->({anon_1 f})) + (fun anon_4(x f)->({{x x} f})) + (fun anon_3(x)->({f {anon_4 x}})) $ 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$2(print_int)->(print_int)) - (fun main()->(let () = ({print_int {{fac_cps 4} {anon$2 }}} 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_2(print_int)->(print_int)) + (fun main()->(let () = ({print_int {{fac_cps 4} {anon_2 }}} in 0))) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml (fun n1(a b n)->((n-1))) (fun ab(a b n)->((a+b))) @@ -134,18 +134,18 @@ (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(b foo)->((foo+2))) - (fun anon$2(b foo)->((foo*10))) - (fun foo(b)->(if (b) then ({anon$1 b}) else ({anon$2 b}))) + (fun anon_1(b foo)->((foo+2))) + (fun anon_2(b foo)->((foo*10))) + (fun foo(b)->(if (b) then ({anon_1 b}) else ({anon_2 b}))) (fun foo_0(x)->({{foo true} {{foo false} {{foo true} {{foo false} x}}}})) (fun main()->(let () = ({print_int {foo_0 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 main()->(let foo_0 = ({foo 1} in let foo_0_2 = ({foo_0 2} in let foo_0_2_4 = ({foo_0_2 3} in let () = ({print_int foo_0_2_4} in 0)))))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - (fun anon$2(b a c)->({print_int c})) - (fun anon$1(a b)->(let () = ({print_int b} in {{anon$2 b} a}))) - (fun foo(a)->(let () = ({print_int a} in {anon$1 a}))) + (fun anon_2(b a c)->({print_int c})) + (fun anon_1(a b)->(let () = ({print_int b} in {{anon_2 b} a}))) + (fun foo(a)->(let () = ({print_int a} in {anon_1 a}))) (fun main()->(let () = ({{{foo 4} 8} 9} in 0))) $ dune exec lambda_lifting_test < manytests/typed/007order.ml : end_of_input From 317b15f3b54426b15fa2d8b7f7c92505b0324127 Mon Sep 17 00:00:00 2001 From: Ivan Date: Tue, 22 Apr 2025 14:14:47 +0300 Subject: [PATCH 41/45] Rewrite pp and remove debug info --- slarnML/lib/anf/clos_conv.ml | 2 +- slarnML/lib/pretty_print/pprint_ast.ml | 6 +- slarnML/test/anf_conv_test.t | 2 - slarnML/test/lambda_lifting_test.t | 2 - slarnML/test/parser_tests.t | 87 ++++++++++++-------------- slarnML/test/riscv64_instr_test.t | 23 ------- 6 files changed, 43 insertions(+), 79 deletions(-) diff --git a/slarnML/lib/anf/clos_conv.ml b/slarnML/lib/anf/clos_conv.ml index 69ea1e382..96c3a5492 100644 --- a/slarnML/lib/anf/clos_conv.ml +++ b/slarnML/lib/anf/clos_conv.ml @@ -18,7 +18,7 @@ let rec closure_conversion ?(env = []) ?(prt_args = []) = function | Ast.Id id -> (match List.find_opt (fun (name, _, _, _) -> name = id) env with | None -> - print_string ("Id " ^ id ^ " not found in env\n"); + (* print_string ("Id " ^ id ^ " not found in env\n"); *) CId id | Some (_, new_name, _, args) -> if List.length args > 0 diff --git a/slarnML/lib/pretty_print/pprint_ast.ml b/slarnML/lib/pretty_print/pprint_ast.ml index 4f14612db..6edfdf52f 100644 --- a/slarnML/lib/pretty_print/pprint_ast.ml +++ b/slarnML/lib/pretty_print/pprint_ast.ml @@ -37,12 +37,12 @@ let rec pp_expr expr = | 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; ")" ] + | 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; ")" ] + 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); ")" ] + concat "" [ "("; pp_expr e; " "; concat " " (List.map pp_expr args); ")" ] ;; let pp_exprs exprs = concat "\t\n" @@ List.map pp_expr exprs diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 18d7d25b4..d26a724e5 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -515,7 +515,6 @@ in anf_app_20 $ dune exec anf_conv_test < manytests/do_not_type/001.ml - Id fac not found in env let recfac n= let anf_op_1=(n<=1) in @@ -542,7 +541,6 @@ in anf_if_1 $ dune exec anf_conv_test < manytests/do_not_type/003occurs.ml - Id f not found in env let anon_2 x f= let anf_app_1=(x x) in diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 344c6373e..969ae2596 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -96,12 +96,10 @@ (fun g(a c d)->(let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}))) (fun f(a)->(let g = (let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}) in {{{g a} 2} 3}))) $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml - Id fac not found in env (fun recfac(n)->(if ((n<=1)) then (1) else ((n*{fac (n-1)})))) $ 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 - Id f not found in env (fun anon_2(x f)->({{x x} f})) (fun anon_1(f x)->({f {{anon_2 x} f}})) (fun fix(f)->({anon_1 f})) diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 37f7923f8..e99be1844 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -1,11 +1,11 @@ $ dune exec parser_test << EOF > let a = 3 > EOF - (let a=3) + let a=(3) $ dune exec parser_test << EOF > let () = 0 > EOF - (let ()=0) + let ()=(0) $ dune exec parser_test << EOF > (fun a -> b) > EOF @@ -13,7 +13,7 @@ $ dune exec parser_test << EOF > let rec a = b in (c) > EOF - (let rec a=b in c) + let rec a=(b) in (c) $ dune exec parser_test << EOF > if a then b else c > EOF @@ -24,11 +24,11 @@ > let c = b in > c > EOF - (let a=(let b=1 in (let c=b in c))) + 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)) + (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 @@ -36,15 +36,15 @@ $ dune exec parser_test << EOF > a b c > EOF - (a->b->c) + (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)) + (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))) + (a+(f 2 x (((g 3)*(z y))*3))) $ dune exec parser_test << EOF > a + 2 <= b * 3 > EOF @@ -56,7 +56,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) + (((a b 2 1)+(3*(b d (-2) (r f))))+3) $ dune exec parser_test << EOF > let fac n = > let rec fack n f = @@ -67,72 +67,63 @@ > 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)))) + 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))) + 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)) + let x=((fack n)) $ dune exec parser_test << EOF > f 1 + f 2 > EOF - ((f->1)+(f->2)) + ((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)))))) + 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))))) + 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)) + 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)))) + 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)) + 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 - (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))) + 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 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)))) + 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 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))))) - (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 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))))) + 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 - + 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)) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index a6cb6bfea..e945feb66 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -140,13 +140,6 @@ ret $ 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) > ;; @@ -240,18 +233,6 @@ ld s0,112(sp) addi sp,sp,128 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 - Id fac not found in env - fac not found $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml .attribute unaligned_access, 0 @@ -294,10 +275,6 @@ addi sp,sp,32 ret - $ dune exec riscv64_instr_test < manytests/do_not_type/003occurs.ml - Id f not found in env - f not found - $ dune exec riscv64_instr_test < manytests/typed/001fac.ml .attribute unaligned_access, 0 .attribute stack_align, 16 From 778e2c0153f1676154eb152c96b998c554b8308f Mon Sep 17 00:00:00 2001 From: Ivan Date: Tue, 22 Apr 2025 15:26:15 +0300 Subject: [PATCH 42/45] Return test fac --- slarnML/lib/anf/lambda_lifting.ml | 3 +- slarnML/lib/pretty_print/pprint_cc.ml | 8 +- slarnML/lib/pretty_print/pprint_ll.ml | 4 +- slarnML/lib/test/anf_test.ml | 285 ++++----------- slarnML/test/anf_conv_test.t | 466 ++++++++---------------- slarnML/test/clos_conv_test.t | 84 ++--- slarnML/test/lambda_lifting_test.t | 159 +++++---- slarnML/test/parser_tests.t | 9 + slarnML/test/riscv64_instr_test.t | 491 ++++++++++++++++++-------- 9 files changed, 695 insertions(+), 814 deletions(-) diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index baf274639..3a19f2216 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -144,7 +144,8 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = then r1 else r1 |> insert_let (get_fun_let (get_decl d) a1)) |> lifting e2 e2_funs g_args stack lvl - |> update_ast (fun a2 -> Result (LIn (id, a1, a2))) + |> update_ast (fun a2 -> + if List.length (get_args d) = 0 then Result (LIn (id, a1, a2)) else Result a2) |> filter lvl | CFun (args, e) -> res diff --git a/slarnML/lib/pretty_print/pprint_cc.ml b/slarnML/lib/pretty_print/pprint_cc.ml index 00c245830..cde37b20b 100644 --- a/slarnML/lib/pretty_print/pprint_cc.ml +++ b/slarnML/lib/pretty_print/pprint_cc.ml @@ -26,15 +26,15 @@ let rec pp_cc_expr expr = "" [ "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; ")" ] + concat "" [ "let "; Pprint_ast.expr_of_decl d; "=("; pp_cc_expr e2; ")" ] | CLetIn (d, e2, e3) -> concat "" - [ "(let " + [ "let " ; Pprint_ast.expr_of_decl d - ; "=" + ; "=(" ; pp_cc_expr e2 - ; " in " + ; ") in (" ; pp_cc_expr e3 ; ")" ] diff --git a/slarnML/lib/pretty_print/pprint_ll.ml b/slarnML/lib/pretty_print/pprint_ll.ml index 2784938b4..971bcd1f7 100644 --- a/slarnML/lib/pretty_print/pprint_ll.ml +++ b/slarnML/lib/pretty_print/pprint_ll.ml @@ -27,12 +27,12 @@ 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 "" [ "{"; pp_ll_expr e; " "; concat " " (List.map pp_ll_expr args); "}" ] + concat "" [ ""; pp_ll_expr 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 | LFun (id, args, e) -> - concat "" [ "(fun "; id; "("; concat " " args; ")->("; pp_ll_expr e; "))" ] + concat "" [ "let "; id; " "; concat " " args; " =("; pp_ll_expr e; ")" ] ;; diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml index d087eef50..9f945fa93 100644 --- a/slarnML/lib/test/anf_test.ml +++ b/slarnML/lib/test/anf_test.ml @@ -222,7 +222,7 @@ let%test _ = cc_ok "cc_6" (clos_conv ast6) cc6 (*==========================*) open Ll_ast open Lambda_lifting -open Pprint_ll +(* open Pprint_ll *) let ll_ok n res expected = match res with @@ -233,9 +233,9 @@ let ll_ok n res expected = "" [ n ; ":\n" - ; String.concat "\n" (List.map pp_gl_expr l_ast) + ; String.concat "\n" (List.map show_gl_expr l_ast) ; "\n---\n" - ; String.concat "\n" (List.map pp_gl_expr expected) + ; String.concat "\n" (List.map show_gl_expr expected) ; "\n====\n" ]; false @@ -257,15 +257,7 @@ let ll1 = ; LFun ( "fac" , [ "n" ] - , LIn - ( "fack" - , LIf - ( LLte (LId "n", LConst (CInt 1)) - , LApp (LId "n", [ LSub (LId "n", LConst (CInt 1)) ]) - , LApp (LApp (LApp (LId "anon_1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) - ) - , LApp (LApp (LId "fack", [ LId "n" ]), [ LApp (LId "anon_2", [ LId "n" ]) ]) ) - ) + , LApp (LApp (LId "fack", [ LId "n" ]), [ LApp (LId "anon_2", [ LId "n" ]) ]) ) ] ;; @@ -279,26 +271,14 @@ let ll2 = ; LFun ( "g" , [ "a"; "c"; "d" ] - , LIn - ( "h" - , LMul (LId "a", LAdd (LId "c", LMul (LId "d", LId "e"))) - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "d" ]), [ LId "a" ]) - , [ LConst (CInt 4) ] ) ) ) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "d" ]), [ LId "a" ]) + , [ LConst (CInt 4) ] ) ) ; LFun ( "f" , [ "a" ] - , LIn - ( "g" - , LIn - ( "h" - , LMul (LId "a", LAdd (LId "c", LMul (LId "d", LId "e"))) - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "d" ]), [ LId "a" ]) - , [ LConst (CInt 4) ] ) ) - , LApp - ( LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]) - , [ LConst (CInt 3) ] ) ) ) + , LApp (LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]), [ LConst (CInt 3) ]) + ) ] ;; @@ -316,25 +296,13 @@ let ll3 = ; LFun ( "g" , [ "a"; "b"; "c" ] - , LIn - ( "h" - , LApp (LApp (LApp (LId "anon_1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) - , [ LId "a" ] ) ) ) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) + , [ LId "a" ] ) ) ; LFun ( "f" , [ "a"; "b" ] - , LIn - ( "g" - , LIn - ( "h" - , LApp (LApp (LApp (LId "anon_1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) - , [ LId "a" ] ) ) - , LApp (LApp (LApp (LId "g", [ LId "a" ]), [ LId "b" ]), [ LConst (CInt 3) ]) ) - ) + , LApp (LApp (LApp (LId "g", [ LId "a" ]), [ LId "b" ]), [ LConst (CInt 3) ]) ) ] ;; @@ -345,27 +313,13 @@ let ll4 = ; LFun ( "g" , [ "a"; "b" ] - , LIn - ( "h" - , LMul (LId "a", LDiv (LId "b", LId "c")) - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]), [ LConst (CInt 2) ]) - , [ LConst (CInt 3) ] ) ) ) + , LApp + ( LApp (LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]), [ LConst (CInt 2) ]) + , [ LConst (CInt 3) ] ) ) ; LFun ( "f" , [ "a" ] - , LIn - ( "g" - , LIn - ( "h" - , LMul (LId "a", LDiv (LId "b", LId "c")) - , LApp - ( LApp - ( LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]) - , [ LConst (CInt 2) ] ) - , [ LConst (CInt 3) ] ) ) - , LApp (LApp (LId "g", [ LAdd (LConst (CInt 1), LConst (CInt 0)) ]), [ LId "a" ]) - ) ) + , LApp (LApp (LId "g", [ LAdd (LConst (CInt 1), LConst (CInt 0)) ]), [ LId "a" ]) ) ] ;; @@ -377,15 +331,9 @@ let ll5 = ; LFun ( "f" , [ "a" ] - , LIn - ( "g" - , LDiv (LId "a", LId "b") - , LIn - ( "h" - , LMul (LId "a", LId "c") - , LAdd - ( LApp (LApp (LId "h", [ LId "a" ]), [ LConst (CInt 1) ]) - , LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]) ) ) ) ) + , LAdd + ( LApp (LApp (LId "h", [ LId "a" ]), [ LConst (CInt 1) ]) + , LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]) ) ) ] ;; @@ -399,15 +347,9 @@ let ll6 = ; LFun ( "f" , [ "a" ] - , LIn - ( "g" - , LApp (LId "anon_1", [ LId "a" ]) - , LIn - ( "h" - , LApp (LId "anon_2", [ LId "a" ]) - , LAdd - ( LApp (LApp (LId "g", [ LId "a" ]), [ LId "a" ]) - , LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]) ) ) ) ) + , LAdd + ( LApp (LApp (LId "g", [ LId "a" ]), [ LId "a" ]) + , LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]) ) ) ] ;; @@ -418,7 +360,7 @@ ll_ok "ll_6" (lambda_lifting cc6) ll6 (*=========================*) open Anf_ast open Anf_conv -open Pprint_anf +(* open Pprint_anf *) let anf_ok n ll expected = let _ = clear_free () in @@ -430,9 +372,9 @@ let anf_ok n ll expected = "" [ n ; ":\n" - ; String.concat "\n" (List.map pp_anf_afun l_ast) + ; String.concat "\n" (List.map show_afun l_ast) ; "\n---\n" - ; String.concat "\n" (List.map pp_anf_afun expected) + ; String.concat "\n" (List.map show_afun expected) ; "\n====\n" ]; false @@ -482,42 +424,15 @@ let anf1 = ( "fac" , [ "n" ] , ALet - ( "anf_op_10" - , ALte (AId "n", AInt 1) + ( "anf_app_10" + , AApp (AId "fack", [ AId "n" ]) , ALet - ( "anf_if_11" - , AIf - ( AId "anf_op_10" - , ALet - ( "anf_op_12" - , ASub (AId "n", AInt 1) - , ALet - ( "anf_app_13" - , AApp (AId "n", [ AId "anf_op_12" ]) - , ACExpr (CImmExpr (AId "anf_app_13")) ) ) - , ALet - ( "anf_app_14" - , AApp (AId "anon_1", [ AId "n" ]) - , ALet - ( "anf_app_15" - , AApp (AId "anf_app_14", [ AId "k" ]) - , ALet - ( "anf_app_16" - , AApp (AId "anf_app_15", [ AId "n" ]) - , ACExpr (CImmExpr (AId "anf_app_16")) ) ) ) ) + ( "anf_app_11" + , AApp (AId "anon_2", [ AId "n" ]) , ALet - ( "fack" - , CImmExpr (AId "anf_if_11") - , ALet - ( "anf_app_17" - , AApp (AId "fack", [ AId "n" ]) - , ALet - ( "anf_app_18" - , AApp (AId "anon_2", [ AId "n" ]) - , ALet - ( "anf_app_19" - , AApp (AId "anf_app_17", [ AId "anf_app_18" ]) - , ACExpr (CImmExpr (AId "anf_app_19")) ) ) ) ) ) ) ) + ( "anf_app_12" + , AApp (AId "anf_app_10", [ AId "anf_app_11" ]) + , ACExpr (CImmExpr (AId "anf_app_12")) ) ) ) ) ] ;; @@ -538,65 +453,31 @@ let anf4 = ( "g" , [ "a"; "b" ] , ALet - ( "anf_op_3" - , ADiv (AId "b", AId "c") + ( "anf_app_3" + , AApp (AId "h", [ AId "a" ]) , ALet - ( "anf_op_4" - , AMul (AId "a", AId "anf_op_3") + ( "anf_app_4" + , AApp (AId "anf_app_3", [ AId "a" ]) , ALet - ( "h" - , CImmExpr (AId "anf_op_4") + ( "anf_app_5" + , AApp (AId "anf_app_4", [ AInt 2 ]) , ALet - ( "anf_app_5" - , AApp (AId "h", [ AId "a" ]) - , ALet - ( "anf_app_6" - , AApp (AId "anf_app_5", [ AId "a" ]) - , ALet - ( "anf_app_7" - , AApp (AId "anf_app_6", [ AInt 2 ]) - , ALet - ( "anf_app_8" - , AApp (AId "anf_app_7", [ AInt 3 ]) - , ACExpr (CImmExpr (AId "anf_app_8")) ) ) ) ) ) ) ) ) + ( "anf_app_6" + , AApp (AId "anf_app_5", [ AInt 3 ]) + , ACExpr (CImmExpr (AId "anf_app_6")) ) ) ) ) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_op_9" - , ADiv (AId "b", AId "c") + ( "anf_op_7" + , AAdd (AInt 1, AInt 0) , ALet - ( "anf_op_10" - , AMul (AId "a", AId "anf_op_9") + ( "anf_app_8" + , AApp (AId "g", [ AId "anf_op_7" ]) , ALet - ( "h" - , CImmExpr (AId "anf_op_10") - , ALet - ( "anf_app_11" - , AApp (AId "h", [ AId "a" ]) - , ALet - ( "anf_app_12" - , AApp (AId "anf_app_11", [ AId "a" ]) - , ALet - ( "anf_app_13" - , AApp (AId "anf_app_12", [ AInt 2 ]) - , ALet - ( "anf_app_14" - , AApp (AId "anf_app_13", [ AInt 3 ]) - , ALet - ( "g" - , CImmExpr (AId "anf_app_14") - , ALet - ( "anf_op_15" - , AAdd (AInt 1, AInt 0) - , ALet - ( "anf_app_16" - , AApp (AId "g", [ AId "anf_op_15" ]) - , ALet - ( "anf_app_17" - , AApp (AId "anf_app_16", [ AId "a" ]) - , ACExpr (CImmExpr (AId "anf_app_17")) - ) ) ) ) ) ) ) ) ) ) ) ) + ( "anf_app_9" + , AApp (AId "anf_app_8", [ AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app_9")) ) ) ) ) ] ;; @@ -615,34 +496,21 @@ let anf5 = ( "f" , [ "a" ] , ALet - ( "anf_op_3" - , ADiv (AId "a", AId "b") + ( "anf_app_3" + , AApp (AId "h", [ AId "a" ]) , ALet - ( "g" - , CImmExpr (AId "anf_op_3") + ( "anf_app_4" + , AApp (AId "anf_app_3", [ AInt 1 ]) , ALet - ( "anf_op_4" - , AMul (AId "a", AId "c") + ( "anf_app_5" + , AApp (AId "g", [ AId "a" ]) , ALet - ( "h" - , CImmExpr (AId "anf_op_4") + ( "anf_app_6" + , AApp (AId "anf_app_5", [ AInt 2 ]) , ALet - ( "anf_app_5" - , AApp (AId "h", [ AId "a" ]) - , ALet - ( "anf_app_6" - , AApp (AId "anf_app_5", [ AInt 1 ]) - , ALet - ( "anf_app_7" - , AApp (AId "g", [ AId "a" ]) - , ALet - ( "anf_app_8" - , AApp (AId "anf_app_7", [ AInt 2 ]) - , ALet - ( "anf_op_9" - , AAdd (AId "anf_app_6", AId "anf_app_8") - , ACExpr (CImmExpr (AId "anf_op_9")) ) ) ) ) ) - ) ) ) ) ) + ( "anf_op_7" + , AAdd (AId "anf_app_4", AId "anf_app_6") + , ACExpr (CImmExpr (AId "anf_op_7")) ) ) ) ) ) ) ] ;; @@ -673,33 +541,20 @@ let anf6 = , [ "a" ] , ALet ( "anf_app_4" - , AApp (AId "anon_1", [ AId "a" ]) + , AApp (AId "g", [ AId "a" ]) , ALet - ( "g" - , CImmExpr (AId "anf_app_4") + ( "anf_app_5" + , AApp (AId "anf_app_4", [ AId "a" ]) , ALet - ( "anf_app_5" - , AApp (AId "anon_2", [ AId "a" ]) + ( "anf_app_6" + , AApp (AId "h", [ AId "a" ]) , ALet - ( "h" - , CImmExpr (AId "anf_app_5") + ( "anf_app_7" + , AApp (AId "anf_app_6", [ AId "a" ]) , ALet - ( "anf_app_6" - , AApp (AId "g", [ AId "a" ]) - , ALet - ( "anf_app_7" - , AApp (AId "anf_app_6", [ AId "a" ]) - , ALet - ( "anf_app_8" - , AApp (AId "h", [ AId "a" ]) - , ALet - ( "anf_app_9" - , AApp (AId "anf_app_8", [ AId "a" ]) - , ALet - ( "anf_op_10" - , AAdd (AId "anf_app_7", AId "anf_app_9") - , ACExpr (CImmExpr (AId "anf_op_10")) ) ) ) ) ) - ) ) ) ) ) + ( "anf_op_8" + , AAdd (AId "anf_app_5", AId "anf_app_7") + , ACExpr (CImmExpr (AId "anf_op_8")) ) ) ) ) ) ) ] ;; diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index d26a724e5..2eec372c7 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -38,33 +38,13 @@ x let fac n= - let anf_op_10=(n<=1) + let anf_app_10=(fack n) in - let anf_if_11=if (anf_op_10) - then ( - let anf_op_12=(n-1) - in - let anf_app_13=(n anf_op_12) - in - anf_app_13 - ) else ( - let anf_app_14=(anon_1 n) - in - let anf_app_15=(anf_app_14 k) - in - let anf_app_16=(anf_app_15 n) - in - anf_app_16) - in - let fack=anf_if_11 - in - let anf_app_17=(fack n) + let anf_app_11=(anon_2 n) in - let anf_app_18=(anon_2 n) + let anf_app_12=(anf_app_10 anf_app_11) in - let anf_app_19=(anf_app_17 anf_app_18) - in - anf_app_19 + anf_app_12 $ dune exec anf_conv_test << EOF > let f a= > let g c d = @@ -83,50 +63,24 @@ anf_op_3 let g a c d= - let anf_op_4=(d*e) - in - let anf_op_5=(c+anf_op_4) + let anf_app_4=(h c) in - let anf_op_6=(a*anf_op_5) + let anf_app_5=(anf_app_4 d) in - let h=anf_op_6 - in - let anf_app_7=(h c) - in - let anf_app_8=(anf_app_7 d) - in - let anf_app_9=(anf_app_8 a) + let anf_app_6=(anf_app_5 a) in - let anf_app_10=(anf_app_9 4) + let anf_app_7=(anf_app_6 4) in - anf_app_10 + anf_app_7 let f a= - let anf_op_11=(d*e) - in - let anf_op_12=(c+anf_op_11) - in - let anf_op_13=(a*anf_op_12) - in - let h=anf_op_13 + let anf_app_8=(g a) in - let anf_app_14=(h c) + let anf_app_9=(anf_app_8 2) in - let anf_app_15=(anf_app_14 d) + let anf_app_10=(anf_app_9 3) in - let anf_app_16=(anf_app_15 a) - in - let anf_app_17=(anf_app_16 4) - in - let g=anf_app_17 - in - let anf_app_18=(g a) - in - let anf_app_19=(anf_app_18 2) - in - let anf_app_20=(anf_app_19 3) - in - anf_app_20 + anf_app_10 $ dune exec anf_conv_test << EOF > let f a b = > let g c = @@ -154,50 +108,24 @@ anf_app_6 let g a b c= - let anf_app_7=(anon_1 c) + let anf_app_7=(h c) in let anf_app_8=(anf_app_7 a) in let anf_app_9=(anf_app_8 b) in - let h=anf_app_9 - in - let anf_app_10=(h c) - in - let anf_app_11=(anf_app_10 a) + let anf_app_10=(anf_app_9 a) in - let anf_app_12=(anf_app_11 b) - in - let anf_app_13=(anf_app_12 a) - in - anf_app_13 + anf_app_10 let f a b= - let anf_app_14=(anon_1 c) - in - let anf_app_15=(anf_app_14 a) - in - let anf_app_16=(anf_app_15 b) - in - let h=anf_app_16 - in - let anf_app_17=(h c) - in - let anf_app_18=(anf_app_17 a) + let anf_app_11=(g a) in - let anf_app_19=(anf_app_18 b) - in - let anf_app_20=(anf_app_19 a) - in - let g=anf_app_20 - in - let anf_app_21=(g a) - in - let anf_app_22=(anf_app_21 b) + let anf_app_12=(anf_app_11 b) in - let anf_app_23=(anf_app_22 3) + let anf_app_13=(anf_app_12 3) in - anf_app_23 + anf_app_13 $ dune exec anf_conv_test << EOF > let f a = > let g a b= @@ -214,46 +142,24 @@ anf_op_2 let g a b= - let anf_op_3=(b/c) + let anf_app_3=(h a) in - let anf_op_4=(a*anf_op_3) - in - let h=anf_op_4 - in - let anf_app_5=(h a) - in - let anf_app_6=(anf_app_5 a) + let anf_app_4=(anf_app_3 a) in - let anf_app_7=(anf_app_6 2) + let anf_app_5=(anf_app_4 2) in - let anf_app_8=(anf_app_7 3) + let anf_app_6=(anf_app_5 3) in - anf_app_8 + anf_app_6 let f a= - let anf_op_9=(b/c) - in - let anf_op_10=(a*anf_op_9) - in - let h=anf_op_10 - in - let anf_app_11=(h a) - in - let anf_app_12=(anf_app_11 a) - in - let anf_app_13=(anf_app_12 2) - in - let anf_app_14=(anf_app_13 3) - in - let g=anf_app_14 - in - let anf_op_15=(1+0) + let anf_op_7=(1+0) in - let anf_app_16=(g anf_op_15) + let anf_app_8=(g anf_op_7) in - let anf_app_17=(anf_app_16 a) + let anf_app_9=(anf_app_8 a) in - anf_app_17 + anf_app_9 $ dune exec anf_conv_test << EOF > let f a = > let g b = a / b in @@ -272,25 +178,17 @@ anf_op_2 let f a= - let anf_op_3=(a/b) - in - let g=anf_op_3 - in - let anf_op_4=(a*c) - in - let h=anf_op_4 - in - let anf_app_5=(h a) + let anf_app_3=(h a) in - let anf_app_6=(anf_app_5 1) + let anf_app_4=(anf_app_3 1) in - let anf_app_7=(g a) + let anf_app_5=(g a) in - let anf_app_8=(anf_app_7 2) + let anf_app_6=(anf_app_5 2) in - let anf_op_9=(anf_app_6+anf_app_8) + let anf_op_7=(anf_app_4+anf_app_6) in - anf_op_9 + anf_op_7 $ dune exec anf_conv_test << EOF > let f a = > let g = (fun x -> x) in @@ -317,25 +215,17 @@ anf_app_3 let f a= - let anf_app_4=(anon_1 a) + let anf_app_4=(g a) in - let g=anf_app_4 - in - let anf_app_5=(anon_2 a) - in - let h=anf_app_5 + let anf_app_5=(anf_app_4 a) in - let anf_app_6=(g a) + let anf_app_6=(h a) in let anf_app_7=(anf_app_6 a) in - let anf_app_8=(h a) - in - let anf_app_9=(anf_app_8 a) - in - let anf_op_10=(anf_app_7+anf_app_9) + let anf_op_8=(anf_app_5+anf_app_7) in - anf_op_10 + anf_op_8 $ 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 @@ -378,37 +268,13 @@ x let fac n= - let anf_op_12=(n<=1) + let anf_app_12=(fack n) 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=(fack anf_op_15) - in - let anf_app_17=(anon_1 n) - in - let anf_app_18=(anf_app_17 f) - in - let anf_app_19=(anf_app_18 n) - in - let anf_app_20=(anf_app_16 anf_app_19) - in - anf_app_20) - in - let fack=anf_if_13 - in - let anf_app_21=(fack n) + let anf_app_13=(anon_2 n) in - let anf_app_22=(anon_2 n) + let anf_app_14=(anf_app_12 anf_app_13) in - let anf_app_23=(anf_app_21 anf_app_22) - in - anf_app_23 + anf_app_14 $ dune exec anf_conv_test << EOF > let fac n = > let rec fack n = if (n < 1) then n else n * (fack (n - 1)) in @@ -433,25 +299,9 @@ anf_if_2 let 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) + let anf_app_6=(fack n) in - let fack=anf_if_7 - in - let anf_app_11=(fack n) - in - anf_app_11 + anf_app_6 $ dune exec anf_conv_test << EOF > let f a = > let g c d = @@ -470,50 +320,24 @@ anf_op_3 let g a c d= - let anf_op_4=(d*e) - in - let anf_op_5=(c+anf_op_4) - in - let anf_op_6=(a*anf_op_5) + let anf_app_4=(h c) in - let h=anf_op_6 + let anf_app_5=(anf_app_4 d) in - let anf_app_7=(h c) - in - let anf_app_8=(anf_app_7 d) - in - let anf_app_9=(anf_app_8 a) + let anf_app_6=(anf_app_5 a) in - let anf_app_10=(anf_app_9 4) + let anf_app_7=(anf_app_6 4) in - anf_app_10 + anf_app_7 let f a= - let anf_op_11=(d*e) - in - let anf_op_12=(c+anf_op_11) - in - let anf_op_13=(a*anf_op_12) - in - let h=anf_op_13 - in - let anf_app_14=(h c) - in - let anf_app_15=(anf_app_14 d) - in - let anf_app_16=(anf_app_15 a) - in - let anf_app_17=(anf_app_16 4) - in - let g=anf_app_17 - in - let anf_app_18=(g a) + let anf_app_8=(g a) in - let anf_app_19=(anf_app_18 2) + let anf_app_9=(anf_app_8 2) in - let anf_app_20=(anf_app_19 3) + let anf_app_10=(anf_app_9 3) in - anf_app_20 + anf_app_10 $ dune exec anf_conv_test < manytests/do_not_type/001.ml let recfac n= let anf_op_1=(n<=1) @@ -665,73 +489,65 @@ then ( b ) else ( - let anf_op_5=(n-1) - in - let n1=anf_op_5 - in - let anf_op_6=(a+b) - in - let ab=anf_op_6 + let anf_app_5=(fib_acc b) in - let anf_app_7=(fib_acc b) + let anf_app_6=(ab a) in - let anf_app_8=(ab a) + let anf_app_7=(anf_app_6 b) in - let anf_app_9=(anf_app_8 b) + let anf_app_8=(anf_app_7 n) in - let anf_app_10=(anf_app_9 n) - in - let anf_app_11=(anf_app_7 anf_app_10) + let anf_app_9=(anf_app_5 anf_app_8) in - let anf_app_12=(n1 a) + let anf_app_10=(n1 a) in - let anf_app_13=(anf_app_12 b) + let anf_app_11=(anf_app_10 b) in - let anf_app_14=(anf_app_13 n) + let anf_app_12=(anf_app_11 n) in - let anf_app_15=(anf_app_11 anf_app_14) + let anf_app_13=(anf_app_9 anf_app_12) in - anf_app_15) + anf_app_13) in anf_if_4 let fib n= - let anf_op_16=(n<2) + let anf_op_14=(n<2) in - let anf_if_17=if (anf_op_16) + let anf_if_15=if (anf_op_14) then ( n ) else ( - let anf_op_18=(n-1) + let anf_op_16=(n-1) in - let anf_op_19=(n-2) + let anf_op_17=(n-2) in - let anf_app_20=(fib anf_op_19) + let anf_app_18=(fib anf_op_17) in - let anf_op_21=(anf_op_18+anf_app_20) + let anf_op_19=(anf_op_16+anf_app_18) in - let anf_app_22=(fib anf_op_21) + let anf_app_20=(fib anf_op_19) in - anf_app_22) + anf_app_20) in - anf_if_17 + anf_if_15 let main = - let anf_app_23=(fib_acc 0) + let anf_app_21=(fib_acc 0) in - let anf_app_24=(anf_app_23 1) + let anf_app_22=(anf_app_21 1) in - let anf_app_25=(anf_app_24 4) + let anf_app_23=(anf_app_22 4) in - let anf_app_26=(print_int anf_app_25) + let anf_app_24=(print_int anf_app_23) in - let ()=anf_app_26 + let ()=anf_app_24 in - let anf_app_27=(fib 4) + let anf_app_25=(fib 4) in - let anf_app_28=(print_int anf_app_27) + let anf_app_26=(print_int anf_app_25) in - let ()=anf_app_28 + let ()=anf_app_26 in 0 $ dune exec anf_conv_test < manytests/typed/004manyargs.ml @@ -762,83 +578,71 @@ anf_app_5 let test3 a b c= - let anf_app_6=(print_int a) - in - let a_0=anf_app_6 - in - let anf_app_7=(print_int b) - in - let b_0=anf_app_7 - in - let anf_app_8=(print_int c) - in - let c_0=anf_app_8 - in 0 let test10 a b c d e f g h i j= - let anf_op_9=(a+b) + let anf_op_6=(a+b) in - let anf_op_10=(anf_op_9+c) + let anf_op_7=(anf_op_6+c) in - let anf_op_11=(anf_op_10+d) + let anf_op_8=(anf_op_7+d) in - let anf_op_12=(anf_op_11+e) + let anf_op_9=(anf_op_8+e) in - let anf_op_13=(anf_op_12+f) + let anf_op_10=(anf_op_9+f) in - let anf_op_14=(anf_op_13+g) + let anf_op_11=(anf_op_10+g) in - let anf_op_15=(anf_op_14+h) + let anf_op_12=(anf_op_11+h) in - let anf_op_16=(anf_op_15+i) + let anf_op_13=(anf_op_12+i) in - let anf_op_17=(anf_op_16+j) + let anf_op_14=(anf_op_13+j) in - anf_op_17 + anf_op_14 let main = - let anf_app_18=(test10 ) + let anf_app_15=(test10 ) in - let anf_app_19=(wrap anf_app_18) + let anf_app_16=(wrap anf_app_15) in - let anf_app_20=(anf_app_19 1) + let anf_app_17=(anf_app_16 1) in - let anf_app_21=(anf_app_20 10) + let anf_app_18=(anf_app_17 10) in - let anf_app_22=(anf_app_21 100) + let anf_app_19=(anf_app_18 100) in - let anf_app_23=(anf_app_22 1000) + let anf_app_20=(anf_app_19 1000) in - let anf_app_24=(anf_app_23 10000) + let anf_app_21=(anf_app_20 10000) in - let anf_app_25=(anf_app_24 100000) + let anf_app_22=(anf_app_21 100000) in - let anf_app_26=(anf_app_25 1000000) + let anf_app_23=(anf_app_22 1000000) in - let anf_app_27=(anf_app_26 10000000) + let anf_app_24=(anf_app_23 10000000) in - let anf_app_28=(anf_app_27 100000000) + let anf_app_25=(anf_app_24 100000000) in - let anf_app_29=(anf_app_28 1000000000) + let anf_app_26=(anf_app_25 1000000000) in - let rez=anf_app_29 + let rez=anf_app_26 in - let anf_app_30=(print_int rez) + let anf_app_27=(print_int rez) in - let ()=anf_app_30 + let ()=anf_app_27 in - let anf_app_31=(test3 ) + let anf_app_28=(test3 ) in - let anf_app_32=(wrap anf_app_31) + let anf_app_29=(wrap anf_app_28) in - let anf_app_33=(anf_app_32 1) + let anf_app_30=(anf_app_29 1) in - let anf_app_34=(anf_app_33 10) + let anf_app_31=(anf_app_30 10) in - let anf_app_35=(anf_app_34 100) + let anf_app_32=(anf_app_31 100) in - let temp2=anf_app_35 + let temp2=anf_app_32 in 0 $ dune exec anf_conv_test < manytests/typed/005fix.ml @@ -1005,11 +809,39 @@ let ()=anf_app_9 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 f a = + > let g c d = + > let h e = a * (c + d * e) in + > (h 4) + > in + > (g 2 3) + > EOF + let h c d a 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 + + let g a c d= + let anf_app_4=(h c) + in + let anf_app_5=(anf_app_4 d) + in + let anf_app_6=(anf_app_5 a) + in + let anf_app_7=(anf_app_6 4) + in + anf_app_7 + + let f a= + let anf_app_8=(g a) + in + let anf_app_9=(anf_app_8 2) + in + let anf_app_10=(anf_app_9 3) + in + anf_app_10 diff --git a/slarnML/test/clos_conv_test.t b/slarnML/test/clos_conv_test.t index b1eedbf9f..6e2492bc5 100644 --- a/slarnML/test/clos_conv_test.t +++ b/slarnML/test/clos_conv_test.t @@ -6,7 +6,7 @@ > in fack n (fun x -> x) > ;; > EOF - (let fac n=(let rec fack n k=if ((n<=1)) then ((n (n-1))) else (((fun n k n m->((k*m)*n)) n k n)) in (fack n ((fun n x->x) n)))) + let fac n=(let rec fack n k=(if ((n<=1)) then ((n (n-1))) else (((fun n k n m->((k*m)*n)) n k n))) in ((fack n ((fun n x->x) n)))) $ dune exec clos_conv_test << EOF > let f a= > let g c d = @@ -15,7 +15,7 @@ > g 2 3 > ;; > EOF - (let f a=(let g a c d=(let h c d a e=(a*(c+(d*e))) in ((h c d a) 4)) in ((g a) 2 3))) + let f a=(let g a c d=(let h c d a e=((a*(c+(d*e)))) in (((h c d a) 4))) in (((g a) 2 3))) $ dune exec clos_conv_test << EOF > let f a b = > let g c = @@ -24,7 +24,7 @@ > g 3 > ;; > EOF - (let f a b=(let g a b c=(let h c a b=((fun c a b x->(x*(a (c*b)))) c a b) in ((h c a b) a)) in ((g a b) 3))) + let f a b=(let g a b c=(let h c a b=(((fun c a b x->(x*(a (c*b)))) c a b)) in (((h c a b) a))) in (((g a b) 3))) $ dune exec clos_conv_test << EOF > let f a = > let g a b= @@ -33,7 +33,7 @@ > g (1+0) a > ;; > EOF - (let f a=(let g a b=(let h a a b c=(a*(b/c)) in ((h a a) 2 3)) in (g (1+0) a))) + let f a=(let g a b=(let h a a b c=((a*(b/c))) in (((h a a) 2 3))) in ((g (1+0) a))) $ dune exec clos_conv_test << EOF > let f a = > let g b = a / b in @@ -41,7 +41,7 @@ > ((h 1) + (g 2)) > ;; > EOF - (let f a=(let g a b=(a/b) in (let h a c=(a*c) in (((h a) 1)+((g a) 2))))) + let f a=(let g a b=((a/b)) in (let h a c=((a*c)) in ((((h a) 1)+((g a) 2))))) $ dune exec clos_conv_test << EOF > let f a = > let g = (fun x -> x) in @@ -49,21 +49,21 @@ > ((g a) + (h a)) > ;; > EOF - (let f a=(let g a=((fun a x->x) a) in (let h a=((fun a x->(a*x)) a) in (((g a) a)+((h a) a))))) + let f a=(let g a=(((fun a x->x) a)) in (let h a=(((fun a x->(a*x)) a)) in ((((g a) a)+((h a) a))))) $ 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 n x->(x*(f n))) n f n))) in (fack n ((fun n x->x) n)))) + let fac n=(let rec fack n f=(if ((n<=1)) then ((f 1)) else ((fack (n-1) ((fun n f n x->(x*(f n))) n f n)))) in ((fack n ((fun n x->x) n)))) $ 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))) + 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 = @@ -72,7 +72,7 @@ > in > (g 2 3) > EOF - (let f a=(let g a c d=(let h c a e d=(a*(c+(d*e))) in ((h c a) 4)) in ((g a) 2 3))) + let f a=(let g a c d=(let h c a e d=((a*(c+(d*e)))) in (((h c a) 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) > @@ -80,42 +80,46 @@ > 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)) + 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/do_not_type/003occurs.ml + let fix f=(((fun f x->(f ((fun x f->(x x f)) x f))) f)) + ((fun x->(f ((fun x f->(x x f)) x))) ) $ 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)) + 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)) + 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 - (let rec fib_acc a b n=if ((n=1)) then (b) else ((let n1 a b n=(n-1) in (let ab a b n=(a+b) in (fib_acc b (ab a b n) (n1 a b n)))))) - (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))) + let rec fib_acc a b n=(if ((n=1)) then (b) else (let n1 a b n=((n-1)) in (let ab a b n=((a+b)) in ((fib_acc b (ab a b n) (n1 a b n)))))) + 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_0 a b c=(print_int a) in (let b_0 a b c=(print_int b) in (let c_0 a b 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 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)))) + let wrap f=(if ((1=1)) then (f) else (f)) + let test3 a b c=(let a_0 a b c=((print_int a)) in (let b_0 a b c=((print_int b)) in (let c_0 a b 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 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))))) - (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 clos_conv_test < manytests/typed/006partial.ml - (let foo b=if (b) then (((fun b foo->(foo+2)) b)) else (((fun b foo->(foo*10)) b))) - (let foo_0 x=(foo true (foo false (foo true (foo false x))))) - (let main=(let ()=(print_int (foo_0 11)) in 0)) + let foo b=(if (b) then (((fun b foo->(foo+2)) b)) else (((fun b foo->(foo*10)) b))) + let foo_0 x=((foo true (foo false (foo true (foo false x))))) + let main=(let ()=((print_int (foo_0 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_0=(foo 1) in (let foo_0_2=(foo_0 2) in (let foo_0_2_4=(foo_0_2 3) in (let ()=(print_int foo_0_2_4) 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_0=((foo 1)) in (let foo_0_2=((foo_0 2)) in (let foo_0_2_4=((foo_0_2 3)) in (let ()=((print_int foo_0_2_4)) in (0))))) $ dune exec clos_conv_test < manytests/typed/006partial3.ml - (let foo a=(let ()=(print_int a) in ((fun a b->(let ()=(print_int b) in ((fun b a c->(print_int c)) b a))) a))) - (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 + let foo a=(let ()=((print_int a)) in (((fun a b->let ()=((print_int b)) in (((fun b a c->(print_int c)) b a))) a))) + let main=(let ()=((foo 4 8 9)) in (0)) + $ 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 c d a e=((a*(c+(d*e)))) in (((h c d a) 4))) in (((g a) 2 3))) diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 969ae2596..51d779eed 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -6,10 +6,10 @@ > in fack n (fun x -> x) > ;; > EOF - (fun anon_1(n k n m)->(((k*m)*n))) - (fun fack(n k)->(if ((n<=1)) then ({n (n-1)}) else ({{{anon_1 n} k} n}))) - (fun anon_2(n x)->(x)) - (fun fac(n)->(let fack = (if ((n<=1)) then ({n (n-1)}) else ({{{anon_1 n} k} n}) in {{fack n} {anon_2 n}}))) + let anon_1 n k n m =(((k*m)*n)) + let fack n k =(if ((n<=1)) then (n (n-1)) else (anon_1 n k n)) + let anon_2 n x =(x) + let fac n =(fack n anon_2 n) $ dune exec lambda_lifting_test << EOF > let f a= > let g c d = @@ -18,9 +18,9 @@ > g 2 3 > ;; > EOF - (fun h(c d a e)->((a*(c+(d*e))))) - (fun g(a c d)->(let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}))) - (fun f(a)->(let g = (let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}) in {{{g a} 2} 3}))) + let h c d a e =((a*(c+(d*e)))) + let g a c d =(h c d a 4) + let f a =(g a 2 3) $ dune exec lambda_lifting_test << EOF > let f a b = > let g c = @@ -29,10 +29,10 @@ > g 3 > ;; > EOF - (fun anon_1(c a b x)->((x*{a (c*b)}))) - (fun h(c a b)->({{{anon_1 c} a} b})) - (fun g(a b c)->(let h = ({{{anon_1 c} a} b} in {{{{h c} a} b} a}))) - (fun f(a b)->(let g = (let h = ({{{anon_1 c} a} b} in {{{{h c} a} b} a}) in {{{g a} b} 3}))) + let anon_1 c a b x =((x*a (c*b))) + let h c a b =(anon_1 c a b) + let g a b c =(h c a b a) + let f a b =(g a b 3) $ dune exec lambda_lifting_test << EOF > let f a = > let g a b= @@ -41,9 +41,9 @@ > g (1+0) a > ;; > EOF - (fun h(a a b c)->((a*(b/c)))) - (fun g(a b)->(let h = ((a*(b/c)) in {{{{h a} a} 2} 3}))) - (fun f(a)->(let g = (let h = ((a*(b/c)) in {{{{h a} a} 2} 3}) in {{g (1+0)} a}))) + let h a a b c =((a*(b/c))) + let g a b =(h a a 2 3) + let f a =(g (1+0) a) $ dune exec lambda_lifting_test << EOF > let f a = > let g b = a / b in @@ -51,9 +51,9 @@ > ((h 1) + (g 2)) > ;; > EOF - (fun g(a b)->((a/b))) - (fun h(a c)->((a*c))) - (fun f(a)->(let g = ((a/b) in let h = ((a*c) in ({{h a} 1}+{{g a} 2}))))) + let g a b =((a/b)) + let h a c =((a*c)) + let f a =((h a 1+g a 2)) $ dune exec lambda_lifting_test << EOF > let f a = > let g = (fun x -> x) in @@ -61,29 +61,29 @@ > ((g a) + (h a)) > ;; > EOF - (fun anon_1(a x)->(x)) - (fun g(a)->({anon_1 a})) - (fun anon_2(a x)->((a*x))) - (fun h(a)->({anon_2 a})) - (fun f(a)->(let g = ({anon_1 a} in let h = ({anon_2 a} in ({{g a} a}+{{h a} a}))))) + let anon_1 a x =(x) + let g a =(anon_1 a) + let anon_2 a x =((a*x)) + let h a =(anon_2 a) + let f a =((g a a+h a a)) $ 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 n x)->((x*{f n}))) - (fun fack(n f)->(if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon_1 n} f} n}}))) - (fun anon_2(n x)->(x)) - (fun fac(n)->(let fack = (if ((n<=1)) then ({f 1}) else ({{fack (n-1)} {{{anon_1 n} f} n}}) in {{fack n} {anon_2 n}}))) + let anon_1 n f n x =((x*f n)) + let fack n f =(if ((n<=1)) then (f 1) else (fack (n-1) anon_1 n f n)) + let anon_2 n x =(x) + let fac n =(fack n anon_2 n) $ 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}))) + let fack n =(if ((n<1)) then (n) else ((n*fack (n-1)))) + let fac n =(fack n) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -92,64 +92,67 @@ > in > (g 2 3) > EOF - (fun h(c d a e)->((a*(c+(d*e))))) - (fun g(a c d)->(let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}))) - (fun f(a)->(let g = (let h = ((a*(c+(d*e))) in {{{{h c} d} a} 4}) in {{{g a} 2} 3}))) + let h c d a e =((a*(c+(d*e)))) + let g a c d =(h c d a 4) + let f a =(g a 2 3) $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml - (fun recfac(n)->(if ((n<=1)) then (1) else ((n*{fac (n-1)})))) + let recfac n =(if ((n<=1)) then (1) else ((n*fac (n-1)))) $ dune exec lambda_lifting_test < manytests/do_not_type/002if.ml - (fun main()->(if (true) then (1) else (false))) + let main =(if (true) then (1) else (false)) $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml - (fun anon_2(x f)->({{x x} f})) - (fun anon_1(f x)->({f {{anon_2 x} f}})) - (fun fix(f)->({anon_1 f})) - (fun anon_4(x f)->({{x x} f})) - (fun anon_3(x)->({f {anon_4 x}})) + let anon_2 x f =(x x f) + let anon_1 f x =(f anon_2 x f) + let fix f =(anon_1 f) + let anon_4 x f =(x x f) + let anon_3 x =(f anon_4 x) $ 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))) + let fac n =(if ((n<=1)) then (1) else ((n*fac (n-1)))) + let 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_2(print_int)->(print_int)) - (fun main()->(let () = ({print_int {{fac_cps 4} {anon_2 }}} in 0))) + let anon_1 n k p =(k (p*n)) + let fac_cps n k =(if ((n=1)) then (k 1) else (fac_cps (n-1) anon_1 n k)) + let anon_2 print_int =(print_int) + let main =(let () = (print_int fac_cps 4 anon_2 in 0)) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml - (fun n1(a b n)->((n-1))) - (fun ab(a b n)->((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 a} b} n}} {{{n1 a} b} n}}))))) - (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)))) + let n1 a b n =((n-1)) + let ab a b n =((a+b)) + let fib_acc a b n =(if ((n=1)) then (b) else (fib_acc b ab a b n n1 a b n)) + let 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 lambda_lifting_test < manytests/typed/004manyargs.ml - (fun wrap(f)->(if ((1=1)) then (f) else (f))) - (fun a_0(a b c)->({print_int a})) - (fun b_0(a b c)->({print_int b})) - (fun c_0(a b c)->({print_int c})) - (fun test3(a b c)->(let a_0 = ({print_int a} in let b_0 = ({print_int b} in let c_0 = ({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 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))))) + let wrap f =(if ((1=1)) then (f) else (f)) + let a_0 a b c =(print_int a) + let b_0 a b c =(print_int b) + let c_0 a b c =(print_int c) + let test3 a b c =(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 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)})))) - (fun main()->(let () = ({print_int {{fix {fac }} 6}} in 0))) + let 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 lambda_lifting_test < manytests/typed/006partial.ml - (fun anon_1(b foo)->((foo+2))) - (fun anon_2(b foo)->((foo*10))) - (fun foo(b)->(if (b) then ({anon_1 b}) else ({anon_2 b}))) - (fun foo_0(x)->({{foo true} {{foo false} {{foo true} {{foo false} x}}}})) - (fun main()->(let () = ({print_int {foo_0 11}} in 0))) + let anon_1 b foo =((foo+2)) + let anon_2 b foo =((foo*10)) + let foo b =(if (b) then (anon_1 b) else (anon_2 b)) + let foo_0 x =(foo true foo false foo true foo false x) + let main =(let () = (print_int foo_0 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 main()->(let foo_0 = ({foo 1} in let foo_0_2 = ({foo_0 2} in let foo_0_2_4 = ({foo_0_2 3} in let () = ({print_int foo_0_2_4} 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_0 = (foo 1 in let foo_0_2 = (foo_0 2 in let foo_0_2_4 = (foo_0_2 3 in let () = (print_int foo_0_2_4 in 0))))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - (fun anon_2(b a c)->({print_int c})) - (fun anon_1(a b)->(let () = ({print_int b} in {{anon_2 b} a}))) - (fun foo(a)->(let () = ({print_int a} in {anon_1 a}))) - (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 + let anon_2 b a c =(print_int c) + let anon_1 a b =(let () = (print_int b in anon_2 b a)) + let foo a =(let () = (print_int a in anon_1 a)) + let main =(let () = (foo 4 8 9 in 0)) + $ 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 + let h c d a e =((a*(c+(d*e)))) + let g a c d =(h c d a 4) + let f a =(g a 2 3) diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index e99be1844..292ea7cca 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -127,3 +127,12 @@ $ 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 << 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 c d=(let h e=((a*(c+(d*e)))) in ((h 4))) in ((g 2 3))) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index e945feb66..5faa4f051 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -1,5 +1,262 @@ $ 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 main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + h: + addi sp,sp,-80 + sd ra,64(sp) + sd s0,56(sp) + addi s0,sp,80 + sd a3,-80(s0) + sd a2,-72(s0) + sd a1,-64(s0) + sd a0,-56(s0) + mul t0,a1,a3 + add t1,a0,t0 + mul t2,a2,t1 + mv a0,t2 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 + ret + g: + addi sp,sp,-176 + sd ra,160(sp) + sd s0,152(sp) + addi s0,sp,176 + sd a2,-176(s0) + sd a1,-168(s0) + sd a0,-160(s0) + lui a0,%hi(h) + addi a0,a0,%lo(h) + ld a3,-168(s0) + li a2,1 + li a1,4 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + ld a3,-176(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + ld a3,-160(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + li a3,4 + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,160(sp) + ld s0,152(sp) + addi sp,sp,176 + ret + f: + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 + sd a0,-128(s0) + lui a0,%hi(g) + addi a0,a0,%lo(g) + ld a3,-128(s0) + li a2,1 + li a1,3 + call part_app + sd a0,-32(s0) + ld a0,-32(s0) + li a3,2 + li a2,1 + li a1,0 + call part_app + sd a0,-40(s0) + ld a0,-40(s0) + li a3,3 + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 + ret + $ 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 main + main: + addi sp,sp,-32 + sd ra,16(sp) + sd s0,8(sp) + sd s1,0(sp) + addi s0,sp,32 + call init_part_apps + call main2 + sd a0,24(sp) + call cleanup_part_apps + ld a0,24(sp) + ld ra,16(sp) + ld s0,8(sp) + ld s1,0(sp) + addi sp,sp,32 + li a7,93 + ecall + anon_1: + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a3,-96(s0) + sd a2,-88(s0) + sd a1,-80(s0) + ld a0,-80(s0) + ld a3,-88(s0) + li a2,1 + li a1,0 + call part_app + ld a1,-96(s0) + mul a2,a1,a0 + mv a0,a2 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 + ret + fack: + addi sp,sp,-256 + sd ra,240(sp) + sd s0,232(sp) + addi s0,sp,256 + sd a1,-256(s0) + sd a0,-248(s0) + li t0,1 + ble a0,t0,.tag_anf_op_3 + li t1,1 + sub t2,a0,t1 + sd t2,-32(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-32(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-40(s0) + lui a0,%hi(anon_1) + addi a0,a0,%lo(anon_1) + ld a3,-248(s0) + li a2,1 + li a1,4 + call part_app + sd a0,-48(s0) + ld a0,-48(s0) + ld a3,-256(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-56(s0) + ld a0,-56(s0) + ld a3,-248(s0) + li a2,1 + li a1,0 + call part_app + sd a0,-64(s0) + ld a0,-40(s0) + ld a3,-64(s0) + li a2,1 + li a1,0 + call part_app + j .tag_anf_op_3_t + .tag_anf_op_3: + sd a0,-72(s0) + ld a0,-256(s0) + li a3,1 + li a2,1 + li a1,0 + call part_app + .tag_anf_op_3_t: + sd a0,-80(s0) + mv a0,a0 + ld ra,240(sp) + ld s0,232(sp) + addi sp,sp,256 + ret + anon_2: + addi sp,sp,-32 + sd ra,24(sp) + sd s0,16(sp) + addi s0,sp,32 + sd a1,-32(s0) + sd a0,-24(s0) + mv a0,a1 + ld ra,24(sp) + ld s0,16(sp) + addi sp,sp,32 + ret + fac: + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 + sd a0,-128(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a3,-128(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-32(s0) + lui a0,%hi(anon_2) + addi a0,a0,%lo(anon_2) + ld a3,-128(s0) + li a2,1 + li a1,2 + call part_app + sd a0,-40(s0) + ld a0,-32(s0) + ld a3,-40(s0) + li a2,1 + li a1,0 + call part_app + mv a0,a0 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 + ret + $ dune exec riscv64_instr_test << EOF + > let f a = > let g = (fun x -> x) in > let h = (fun x -> a * x) in > ((g a) + (h a)) @@ -85,58 +342,42 @@ addi sp,sp,64 ret f: - addi sp,sp,-240 - sd ra,232(sp) - sd s0,224(sp) - addi s0,sp,240 - sd a0,-240(s0) - lui a0,%hi(anon_1) - addi a0,a0,%lo(anon_1) - ld a3,-240(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-32(s0) - sd a0,-40(s0) - lui a0,%hi(anon_2) - addi a0,a0,%lo(anon_2) - ld a3,-240(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-48(s0) - sd a0,-56(s0) + addi sp,sp,-160 + sd ra,152(sp) + sd s0,144(sp) + addi s0,sp,160 + sd a0,-160(s0) lui a0,%hi(g) addi a0,a0,%lo(g) - ld a3,-240(s0) + ld a3,-160(s0) li a2,1 li a1,1 call part_app - sd a0,-64(s0) - ld a0,-64(s0) - ld a3,-240(s0) + sd a0,-32(s0) + ld a0,-32(s0) + ld a3,-160(s0) li a2,1 li a1,0 call part_app - sd a0,-72(s0) + sd a0,-40(s0) lui a0,%hi(h) addi a0,a0,%lo(h) - ld a3,-240(s0) + ld a3,-160(s0) li a2,1 li a1,1 call part_app - sd a0,-80(s0) - ld a0,-80(s0) - ld a3,-240(s0) + sd a0,-48(s0) + ld a0,-48(s0) + ld a3,-160(s0) li a2,1 li a1,0 call part_app - ld t0,-72(s0) + ld t0,-40(s0) add t1,t0,a0 mv a0,t1 - ld ra,232(sp) - ld s0,224(sp) - addi sp,sp,240 + ld ra,152(sp) + ld s0,144(sp) + addi sp,sp,160 ret $ dune exec riscv64_instr_test << EOF > let fac n = @@ -195,43 +436,21 @@ addi sp,sp,96 ret fac: - addi sp,sp,-128 - sd ra,120(sp) - sd s0,112(sp) - addi s0,sp,128 - sd a0,-128(s0) - li t0,1 - blt a0,t0,.tag_anf_op_6 - li t1,1 - sub t2,a0,t1 - sd t2,-32(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-32(s0) - li a2,1 - li a1,1 - call part_app - ld t2,-128(s0) - mul t1,t2,a0 - sd a0,-40(s0) - mv a0,t1 - j .tag_anf_op_6_t - .tag_anf_op_6: - mv a0,t2 - .tag_anf_op_6_t: - sd a0,-48(s0) - sd t1,-56(s0) + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 sd a0,-64(s0) lui a0,%hi(fack) addi a0,a0,%lo(fack) - ld a3,-128(s0) + ld a3,-64(s0) li a2,1 li a1,1 call part_app mv a0,a0 - ld ra,120(sp) - ld s0,112(sp) - addi sp,sp,128 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 ret $ dune exec riscv64_instr_test < manytests/do_not_type/002if.ml @@ -545,88 +764,81 @@ addi sp,sp,48 ret fib_acc: - addi sp,sp,-384 - sd ra,368(sp) - sd s0,360(sp) - addi s0,sp,384 - sd a2,-384(s0) - sd a1,-376(s0) - sd a0,-368(s0) + addi sp,sp,-352 + sd ra,336(sp) + sd s0,328(sp) + addi s0,sp,352 + sd a2,-352(s0) + sd a1,-344(s0) + sd a0,-336(s0) li t0,1 beq a2,t0,.tag_anf_op_3 - li t1,1 - sub t2,a2,t1 - sd t2,-32(s0) - add t3,a0,a1 - sd t3,-40(s0) - sd t2,-48(s0) - sd t3,-56(s0) lui a0,%hi(fib_acc) addi a0,a0,%lo(fib_acc) - ld a3,-376(s0) + ld a3,-344(s0) li a2,1 li a1,3 call part_app - sd a0,-64(s0) + sd a0,-32(s0) lui a0,%hi(ab) addi a0,a0,%lo(ab) - ld a3,-368(s0) + ld a3,-336(s0) li a2,1 li a1,3 call part_app - sd a0,-72(s0) - ld a0,-72(s0) - ld a3,-376(s0) + sd a0,-40(s0) + ld a0,-40(s0) + ld a3,-344(s0) li a2,1 li a1,0 call part_app - sd a0,-80(s0) - ld a0,-80(s0) - ld a3,-384(s0) + sd a0,-48(s0) + ld a0,-48(s0) + ld a3,-352(s0) li a2,1 li a1,0 call part_app - sd a0,-88(s0) - ld a0,-64(s0) - ld a3,-88(s0) + sd a0,-56(s0) + ld a0,-32(s0) + ld a3,-56(s0) li a2,1 li a1,0 call part_app - sd a0,-96(s0) + sd a0,-64(s0) lui a0,%hi(n1) addi a0,a0,%lo(n1) - ld a3,-368(s0) + ld a3,-336(s0) li a2,1 li a1,3 call part_app - sd a0,-104(s0) - ld a0,-104(s0) - ld a3,-376(s0) + sd a0,-72(s0) + ld a0,-72(s0) + ld a3,-344(s0) li a2,1 li a1,0 call part_app - sd a0,-112(s0) - ld a0,-112(s0) - ld a3,-384(s0) + sd a0,-80(s0) + ld a0,-80(s0) + ld a3,-352(s0) li a2,1 li a1,0 call part_app - sd a0,-120(s0) - ld a0,-96(s0) - ld a3,-120(s0) + sd a0,-88(s0) + ld a0,-64(s0) + ld a3,-88(s0) li a2,1 li a1,0 call part_app j .tag_anf_op_3_t .tag_anf_op_3: - ld t3,-376(s0) - sd a0,-128(s0) - mv a0,t3 + ld t0,-344(s0) + sd a0,-96(s0) + mv a0,t0 .tag_anf_op_3_t: mv a0,a0 - ld ra,368(sp) - ld s0,360(sp) - addi sp,sp,384 + ld ra,336(sp) + ld s0,328(sp) + addi sp,sp,352 ret fib: addi sp,sp,-128 @@ -635,7 +847,7 @@ addi s0,sp,128 sd a0,-128(s0) li t0,2 - blt a0,t0,.tag_anf_op_16 + blt a0,t0,.tag_anf_op_14 li t1,1 sub t2,a0,t1 li t3,2 @@ -658,12 +870,12 @@ li a2,1 li a1,1 call part_app - j .tag_anf_op_16_t - .tag_anf_op_16: + j .tag_anf_op_14_t + .tag_anf_op_14: ld t3,-128(s0) sd a0,-64(s0) mv a0,t3 - .tag_anf_op_16_t: + .tag_anf_op_14_t: mv a0,a0 ld ra,120(sp) ld s0,112(sp) @@ -818,41 +1030,18 @@ addi sp,sp,80 ret test3: - addi sp,sp,-160 - sd ra,152(sp) - sd s0,144(sp) - addi s0,sp,160 - sd a2,-160(s0) - sd a1,-152(s0) - sd a0,-144(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-144(s0) - li a2,1 - li a1,1 - call part_app + addi sp,sp,-48 + sd ra,32(sp) + sd s0,24(sp) + addi s0,sp,48 + sd a2,-48(s0) + sd a1,-40(s0) sd a0,-32(s0) - sd a0,-40(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-152(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-48(s0) - sd a0,-56(s0) - lui a0,%hi(print_int) - addi a0,a0,%lo(print_int) - ld a3,-160(s0) - li a2,1 - li a1,1 - call part_app - sd a0,-64(s0) - li a1,0 - mv a0,a1 - ld ra,152(sp) - ld s0,144(sp) - addi sp,sp,160 + li t0,0 + mv a0,t0 + ld ra,32(sp) + ld s0,24(sp) + addi sp,sp,48 ret test10: addi sp,sp,-160 @@ -1523,15 +1712,3 @@ addi sp,sp,128 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 0cf81b0876a7bce087e6ef6e49868bb49f501067 Mon Sep 17 00:00:00 2001 From: Ivan Date: Wed, 23 Apr 2025 15:28:14 +0300 Subject: [PATCH 43/45] Rewrite app for lambda lifting --- slarnML/lib/anf/lambda_lifting.ml | 101 ++++-- slarnML/lib/pretty_print/pprint_ll.ml | 2 +- slarnML/lib/riscv64/part_app.c | 16 +- slarnML/lib/test/anf_test.ml | 106 ++---- slarnML/test/anf_conv_test.t | 274 +++++---------- slarnML/test/exec_test.t_ | Bin 4339 -> 4307 bytes slarnML/test/lambda_lifting_test.t | 106 +++--- slarnML/test/parser_tests.t | 4 - slarnML/test/riscv64_instr_test.t | 466 ++++++++++---------------- 9 files changed, 429 insertions(+), 646 deletions(-) diff --git a/slarnML/lib/anf/lambda_lifting.ml b/slarnML/lib/anf/lambda_lifting.ml index 3a19f2216..ad7115a96 100644 --- a/slarnML/lib/anf/lambda_lifting.ml +++ b/slarnML/lib/anf/lambda_lifting.ml @@ -184,32 +184,70 @@ let rec lifting cc_ast fun_ids g_args stack lvl res = | _ -> Error "Apply on not correct expr") ;; -let rec unwrap_app expr = +let rec drop n lst = + match n, lst with + | 0, _ -> lst + | _, [] -> [] + | _, _ :: tail -> drop (n - 1) tail +;; + +let take n lst = + let rec helper n lst acc = + match n, lst with + | 0, _ -> acc + | _, [] -> acc + | _, hd :: tail -> helper (n - 1) tail (hd :: acc) + in + List.rev (helper n lst []) +;; + +let rec unwrap_app args_cnt expr = match expr with - | LApp (id, args) -> - (match args with - | [] -> expr - | [ arg ] -> LApp (unwrap_app id, [ unwrap_app arg ]) - | fst :: args -> - List.fold_left - (fun app arg -> LApp (app, [ unwrap_app arg ])) - (LApp (unwrap_app id, [ unwrap_app fst ])) - args) + | LApp (e_id, args) -> + (match e_id with + | LId id when Option.is_some (List.find_opt (fun (name, _) -> name = id) args_cnt) -> + (match List.find_opt (fun (name, _) -> name = id) args_cnt with + | None -> expr + | Some (_, arg_cnt) -> + (* print_string (id^" "^(string_of_int arg_cnt)^"\n"); *) + let other_args = + List.map (fun arg -> unwrap_app args_cnt arg) (drop arg_cnt args) + in + (match other_args with + | [] -> LApp (LId id, List.map (fun arg -> unwrap_app args_cnt arg) args) + | _ -> + let applied_args = + List.map (fun arg -> unwrap_app args_cnt arg) (take arg_cnt args) + in + List.fold_left + (fun app arg -> LApp (app, [ arg ])) + (LApp (LId id, applied_args)) + other_args)) + | _ -> + (match args with + | [] -> expr + | [ arg ] -> LApp (unwrap_app args_cnt e_id, [ unwrap_app args_cnt arg ]) + | fst :: args -> + List.fold_left + (fun app arg -> LApp (app, [ unwrap_app args_cnt arg ])) + (LApp (unwrap_app args_cnt e_id, [ unwrap_app args_cnt fst ])) + args)) | LId _ | LConst _ -> expr - | LNot e -> LNot (unwrap_app e) - | LOr (e1, e2) -> LOr (unwrap_app e1, unwrap_app e2) - | LAnd (e1, e2) -> LAnd (unwrap_app e1, unwrap_app e2) - | LEq (e1, e2) -> LEq (unwrap_app e1, unwrap_app e2) - | LGt (e1, e2) -> LGt (unwrap_app e1, unwrap_app e2) - | LLt (e1, e2) -> LLt (unwrap_app e1, unwrap_app e2) - | LGte (e1, e2) -> LGte (unwrap_app e1, unwrap_app e2) - | LLte (e1, e2) -> LLte (unwrap_app e1, unwrap_app e2) - | LAdd (e1, e2) -> LAdd (unwrap_app e1, unwrap_app e2) - | LSub (e1, e2) -> LSub (unwrap_app e1, unwrap_app e2) - | LMul (e1, e2) -> LMul (unwrap_app e1, unwrap_app e2) - | LDiv (e1, e2) -> LDiv (unwrap_app e1, unwrap_app e2) - | LIf (e1, e2, e3) -> LIf (unwrap_app e1, unwrap_app e2, unwrap_app e3) - | LIn (id, e1, e2) -> LIn (id, unwrap_app e1, unwrap_app e2) + | LNot e -> LNot (unwrap_app args_cnt e) + | LOr (e1, e2) -> LOr (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LAnd (e1, e2) -> LAnd (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LEq (e1, e2) -> LEq (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LGt (e1, e2) -> LGt (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LLt (e1, e2) -> LLt (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LGte (e1, e2) -> LGte (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LLte (e1, e2) -> LLte (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LAdd (e1, e2) -> LAdd (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LSub (e1, e2) -> LSub (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LMul (e1, e2) -> LMul (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LDiv (e1, e2) -> LDiv (unwrap_app args_cnt e1, unwrap_app args_cnt e2) + | LIf (e1, e2, e3) -> + LIf (unwrap_app args_cnt e1, unwrap_app args_cnt e2, unwrap_app args_cnt e3) + | LIn (id, e1, e2) -> LIn (id, unwrap_app args_cnt e1, unwrap_app args_cnt e2) ;; let default_res num = Result (LId "Error", [], [], num) @@ -237,10 +275,13 @@ let lambda_lifting cc_ast = Result ast >>= fun g_ast -> Result - (List.fold_left - (fun acc ast -> - match ast with - | LFun (id, args, e) -> acc @ [ LFun (id, args, unwrap_app e) ]) - [] - g_ast) + ((fun (e, _) -> e) + (List.fold_left + (fun (acc, acc_cnt) ast -> + match ast with + | LFun (id, args, e) -> + ( acc @ [ LFun (id, args, unwrap_app ((id, List.length args) :: acc_cnt) e) ] + , (id, List.length args) :: acc_cnt )) + ([], []) + g_ast)) ;; diff --git a/slarnML/lib/pretty_print/pprint_ll.ml b/slarnML/lib/pretty_print/pprint_ll.ml index 971bcd1f7..3d4534134 100644 --- a/slarnML/lib/pretty_print/pprint_ll.ml +++ b/slarnML/lib/pretty_print/pprint_ll.ml @@ -27,7 +27,7 @@ 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 "" [ ""; pp_ll_expr e; " "; concat " " (List.map pp_ll_expr args); "" ] + concat "" [ "("; pp_ll_expr e; " "; concat " " (List.map pp_ll_expr args); ")" ] | LIn (id, e1, e2) -> concat "" [ "let "; id; " = ("; pp_ll_expr e1; " in "; pp_ll_expr e2; ")" ] ;; diff --git a/slarnML/lib/riscv64/part_app.c b/slarnML/lib/riscv64/part_app.c index 8daa66542..e780719ac 100644 --- a/slarnML/lib/riscv64/part_app.c +++ b/slarnML/lib/riscv64/part_app.c @@ -151,12 +151,12 @@ int64_t app_n(struct Func *f) { } int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { - fprintf(stdout, "Warning: %p(%ld) [%d %d]", f->ptr, (int64_t)f, f->argscnt, f->cnt); - if (cnt > 0) { - fprintf(stdout, " -> %ld\n", args[0]); - } else { - fprintf(stdout, "\n"); - } + // fprintf(stdout, "Warning: %p(%ld) [%d %d]", f->ptr, (int64_t)f, f->argscnt, f->cnt); + // if (cnt > 0) { + // fprintf(stdout, " -> %ld\n", args[0]); + // } else { + // fprintf(stdout, "\n"); + // } if (f == NULL || args == NULL) { fprintf(stderr, "Error: NULL pointer in app function\n"); @@ -176,7 +176,7 @@ int64_t app(struct Func *f, uint8_t cnt, int64_t *args) { int64_t ret = app_n(f); if (new_cnt > f->argscnt) { - fprintf(stdout, "Warning: overflow args\n"); + // fprintf(stdout, "Warning: overflow args\n"); int64_t new_args[MAX_ARGS]; for (int i = 0; i < new_cnt - f->argscnt && i < MAX_ARGS; i++) { new_args[i] = args[i + (f->argscnt - f_cnt)]; @@ -225,7 +225,7 @@ int64_t part_app(void *f_ptr, int argcnt, int appcnt, ...) { last_app = (last_app + 1) % MAX_APPS; int64_t ret = app(&part_apps[app_idx], appcnt, args); - fprintf(stdout, "Result: %ld\n", ret); + // fprintf(stdout, "Result: %ld\n", ret); return ret; } diff --git a/slarnML/lib/test/anf_test.ml b/slarnML/lib/test/anf_test.ml index 9f945fa93..b55b2afdc 100644 --- a/slarnML/lib/test/anf_test.ml +++ b/slarnML/lib/test/anf_test.ml @@ -252,12 +252,9 @@ let ll1 = , LIf ( LLte (LId "n", LConst (CInt 1)) , LApp (LId "n", [ LSub (LId "n", LConst (CInt 1)) ]) - , LApp (LApp (LApp (LId "anon_1", [ LId "n" ]), [ LId "k" ]), [ LId "n" ]) ) ) + , LApp (LId "anon_1", [ LId "n"; LId "k"; LId "n" ]) ) ) ; LFun ("anon_2", [ "n"; "x" ], LId "x") - ; LFun - ( "fac" - , [ "n" ] - , LApp (LApp (LId "fack", [ LId "n" ]), [ LApp (LId "anon_2", [ LId "n" ]) ]) ) + ; LFun ("fac", [ "n" ], LApp (LId "fack", [ LId "n"; LApp (LId "anon_2", [ LId "n" ]) ])) ] ;; @@ -271,14 +268,8 @@ let ll2 = ; LFun ( "g" , [ "a"; "c"; "d" ] - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "d" ]), [ LId "a" ]) - , [ LConst (CInt 4) ] ) ) - ; LFun - ( "f" - , [ "a" ] - , LApp (LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]), [ LConst (CInt 3) ]) - ) + , LApp (LId "h", [ LId "c"; LId "d"; LId "a"; LConst (CInt 4) ]) ) + ; LFun ("f", [ "a" ], LApp (LId "g", [ LId "a"; LConst (CInt 2); LConst (CInt 3) ])) ] ;; @@ -289,20 +280,12 @@ let ll3 = ( "anon_1" , [ "c"; "a"; "b"; "x" ] , LMul (LId "x", LApp (LId "a", [ LMul (LId "c", LId "b") ])) ) - ; LFun - ( "h" - , [ "c"; "a"; "b" ] - , LApp (LApp (LApp (LId "anon_1", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) ) + ; LFun ("h", [ "c"; "a"; "b" ], LApp (LId "anon_1", [ LId "c"; LId "a"; LId "b" ])) ; LFun ( "g" , [ "a"; "b"; "c" ] - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "c" ]), [ LId "a" ]), [ LId "b" ]) - , [ LId "a" ] ) ) - ; LFun - ( "f" - , [ "a"; "b" ] - , LApp (LApp (LApp (LId "g", [ LId "a" ]), [ LId "b" ]), [ LConst (CInt 3) ]) ) + , LApp (LApp (LId "h", [ LId "c"; LId "a"; LId "b" ]), [ LId "a" ]) ) + ; LFun ("f", [ "a"; "b" ], LApp (LId "g", [ LId "a"; LId "b"; LConst (CInt 3) ])) ] ;; @@ -313,13 +296,9 @@ let ll4 = ; LFun ( "g" , [ "a"; "b" ] - , LApp - ( LApp (LApp (LApp (LId "h", [ LId "a" ]), [ LId "a" ]), [ LConst (CInt 2) ]) - , [ LConst (CInt 3) ] ) ) + , LApp (LId "h", [ LId "a"; LId "a"; LConst (CInt 2); LConst (CInt 3) ]) ) ; LFun - ( "f" - , [ "a" ] - , LApp (LApp (LId "g", [ LAdd (LConst (CInt 1), LConst (CInt 0)) ]), [ LId "a" ]) ) + ("f", [ "a" ], LApp (LId "g", [ LAdd (LConst (CInt 1), LConst (CInt 0)); LId "a" ])) ] ;; @@ -332,8 +311,8 @@ let ll5 = ( "f" , [ "a" ] , LAdd - ( LApp (LApp (LId "h", [ LId "a" ]), [ LConst (CInt 1) ]) - , LApp (LApp (LId "g", [ LId "a" ]), [ LConst (CInt 2) ]) ) ) + ( LApp (LId "h", [ LId "a"; LConst (CInt 1) ]) + , LApp (LId "g", [ LId "a"; LConst (CInt 2) ]) ) ) ] ;; @@ -410,29 +389,20 @@ let anf1 = , ACExpr (CImmExpr (AId "anf_app_6")) ) ) , ALet ( "anf_app_7" - , AApp (AId "anon_1", [ AId "n" ]) - , ALet - ( "anf_app_8" - , AApp (AId "anf_app_7", [ AId "k" ]) - , ALet - ( "anf_app_9" - , AApp (AId "anf_app_8", [ AId "n" ]) - , ACExpr (CImmExpr (AId "anf_app_9")) ) ) ) ) + , AApp (AId "anon_1", [ AId "n"; AId "k"; AId "n" ]) + , ACExpr (CImmExpr (AId "anf_app_7")) ) ) , ACExpr (CImmExpr (AId "anf_if_4")) ) ) ) ; AFun ("anon_2", [ "n"; "x" ], ACExpr (CImmExpr (AId "x"))) ; AFun ( "fac" , [ "n" ] , ALet - ( "anf_app_10" - , AApp (AId "fack", [ AId "n" ]) + ( "anf_app_8" + , AApp (AId "anon_2", [ AId "n" ]) , ALet - ( "anf_app_11" - , AApp (AId "anon_2", [ AId "n" ]) - , ALet - ( "anf_app_12" - , AApp (AId "anf_app_10", [ AId "anf_app_11" ]) - , ACExpr (CImmExpr (AId "anf_app_12")) ) ) ) ) + ( "anf_app_9" + , AApp (AId "fack", [ AId "n"; AId "anf_app_8" ]) + , ACExpr (CImmExpr (AId "anf_app_9")) ) ) ) ] ;; @@ -454,30 +424,18 @@ let anf4 = , [ "a"; "b" ] , ALet ( "anf_app_3" - , AApp (AId "h", [ AId "a" ]) - , ALet - ( "anf_app_4" - , AApp (AId "anf_app_3", [ AId "a" ]) - , ALet - ( "anf_app_5" - , AApp (AId "anf_app_4", [ AInt 2 ]) - , ALet - ( "anf_app_6" - , AApp (AId "anf_app_5", [ AInt 3 ]) - , ACExpr (CImmExpr (AId "anf_app_6")) ) ) ) ) ) + , AApp (AId "h", [ AId "a"; AId "a"; AInt 2; AInt 3 ]) + , ACExpr (CImmExpr (AId "anf_app_3")) ) ) ; AFun ( "f" , [ "a" ] , ALet - ( "anf_op_7" + ( "anf_op_4" , AAdd (AInt 1, AInt 0) , ALet - ( "anf_app_8" - , AApp (AId "g", [ AId "anf_op_7" ]) - , ALet - ( "anf_app_9" - , AApp (AId "anf_app_8", [ AId "a" ]) - , ACExpr (CImmExpr (AId "anf_app_9")) ) ) ) ) + ( "anf_app_5" + , AApp (AId "g", [ AId "anf_op_4"; AId "a" ]) + , ACExpr (CImmExpr (AId "anf_app_5")) ) ) ) ] ;; @@ -497,20 +455,14 @@ let anf5 = , [ "a" ] , ALet ( "anf_app_3" - , AApp (AId "h", [ AId "a" ]) + , AApp (AId "h", [ AId "a"; AInt 1 ]) , ALet ( "anf_app_4" - , AApp (AId "anf_app_3", [ AInt 1 ]) + , AApp (AId "g", [ AId "a"; AInt 2 ]) , ALet - ( "anf_app_5" - , AApp (AId "g", [ AId "a" ]) - , ALet - ( "anf_app_6" - , AApp (AId "anf_app_5", [ AInt 2 ]) - , ALet - ( "anf_op_7" - , AAdd (AId "anf_app_4", AId "anf_app_6") - , ACExpr (CImmExpr (AId "anf_op_7")) ) ) ) ) ) ) + ( "anf_op_5" + , AAdd (AId "anf_app_3", AId "anf_app_4") + , ACExpr (CImmExpr (AId "anf_op_5")) ) ) ) ) ] ;; diff --git a/slarnML/test/anf_conv_test.t b/slarnML/test/anf_conv_test.t index 2eec372c7..500349214 100644 --- a/slarnML/test/anf_conv_test.t +++ b/slarnML/test/anf_conv_test.t @@ -24,13 +24,9 @@ in anf_app_6 ) else ( - let anf_app_7=(anon_1 n) + let anf_app_7=(anon_1 n k n) in - let anf_app_8=(anf_app_7 k) - in - let anf_app_9=(anf_app_8 n) - in - anf_app_9) + anf_app_7) in anf_if_4 @@ -38,13 +34,11 @@ x let fac n= - let anf_app_10=(fack n) - in - let anf_app_11=(anon_2 n) + let anf_app_8=(anon_2 n) in - let anf_app_12=(anf_app_10 anf_app_11) + let anf_app_9=(fack n anf_app_8) in - anf_app_12 + anf_app_9 $ dune exec anf_conv_test << EOF > let f a= > let g c d = @@ -63,24 +57,14 @@ anf_op_3 let g a c d= - let anf_app_4=(h c) - in - let anf_app_5=(anf_app_4 d) - in - let anf_app_6=(anf_app_5 a) - in - let anf_app_7=(anf_app_6 4) + let anf_app_4=(h c d a 4) in - anf_app_7 + anf_app_4 let f a= - let anf_app_8=(g a) - in - let anf_app_9=(anf_app_8 2) - in - let anf_app_10=(anf_app_9 3) + let anf_app_5=(g a 2 3) in - anf_app_10 + anf_app_5 $ dune exec anf_conv_test << EOF > let f a b = > let g c = @@ -99,33 +83,21 @@ anf_op_3 let h c a b= - let anf_app_4=(anon_1 c) - in - let anf_app_5=(anf_app_4 a) - in - let anf_app_6=(anf_app_5 b) + let anf_app_4=(anon_1 c a b) in - anf_app_6 + anf_app_4 let g a b c= - let anf_app_7=(h c) - in - let anf_app_8=(anf_app_7 a) - in - let anf_app_9=(anf_app_8 b) + let anf_app_5=(h c a b) in - let anf_app_10=(anf_app_9 a) + let anf_app_6=(anf_app_5 a) in - anf_app_10 + anf_app_6 let f a b= - let anf_app_11=(g a) - in - let anf_app_12=(anf_app_11 b) - in - let anf_app_13=(anf_app_12 3) + let anf_app_7=(g a b 3) in - anf_app_13 + anf_app_7 $ dune exec anf_conv_test << EOF > let f a = > let g a b= @@ -142,24 +114,16 @@ anf_op_2 let g a b= - let anf_app_3=(h a) - in - let anf_app_4=(anf_app_3 a) + let anf_app_3=(h a a 2 3) in - let anf_app_5=(anf_app_4 2) - in - let anf_app_6=(anf_app_5 3) - in - anf_app_6 + anf_app_3 let f a= - let anf_op_7=(1+0) - in - let anf_app_8=(g anf_op_7) + let anf_op_4=(1+0) in - let anf_app_9=(anf_app_8 a) + let anf_app_5=(g anf_op_4 a) in - anf_app_9 + anf_app_5 $ dune exec anf_conv_test << EOF > let f a = > let g b = a / b in @@ -178,17 +142,13 @@ anf_op_2 let f a= - let anf_app_3=(h a) - in - let anf_app_4=(anf_app_3 1) + let anf_app_3=(h a 1) in - let anf_app_5=(g a) + let anf_app_4=(g a 2) in - let anf_app_6=(anf_app_5 2) + let anf_op_5=(anf_app_3+anf_app_4) in - let anf_op_7=(anf_app_4+anf_app_6) - in - anf_op_7 + anf_op_5 $ dune exec anf_conv_test << EOF > let f a = > let g = (fun x -> x) in @@ -250,17 +210,11 @@ ) else ( let anf_op_6=(n-1) in - let anf_app_7=(fack anf_op_6) - in - let anf_app_8=(anon_1 n) + let anf_app_7=(anon_1 n f n) in - let anf_app_9=(anf_app_8 f) + let anf_app_8=(fack anf_op_6 anf_app_7) in - let anf_app_10=(anf_app_9 n) - in - let anf_app_11=(anf_app_7 anf_app_10) - in - anf_app_11) + anf_app_8) in anf_if_4 @@ -268,13 +222,11 @@ x let fac n= - let anf_app_12=(fack n) - in - let anf_app_13=(anon_2 n) + let anf_app_9=(anon_2 n) in - let anf_app_14=(anf_app_12 anf_app_13) + let anf_app_10=(fack n anf_app_9) in - anf_app_14 + 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 @@ -320,24 +272,14 @@ anf_op_3 let g a c d= - let anf_app_4=(h c) - in - let anf_app_5=(anf_app_4 d) + let anf_app_4=(h c d a 4) in - let anf_app_6=(anf_app_5 a) - in - let anf_app_7=(anf_app_6 4) - in - anf_app_7 + anf_app_4 let f a= - let anf_app_8=(g a) - in - let anf_app_9=(anf_app_8 2) + let anf_app_5=(g a 2 3) in - let anf_app_10=(anf_app_9 3) - in - anf_app_10 + anf_app_5 $ dune exec anf_conv_test < manytests/do_not_type/001.ml let recfac n= let anf_op_1=(n<=1) @@ -373,32 +315,30 @@ anf_app_2 let anon_1 f x= - let anf_app_3=(anon_2 x) + let anf_app_3=(anon_2 x f) in - let anf_app_4=(anf_app_3 f) + let anf_app_4=(f anf_app_3) in - let anf_app_5=(f anf_app_4) - in - anf_app_5 + anf_app_4 let fix f= - let anf_app_6=(anon_1 f) + let anf_app_5=(anon_1 f) in - anf_app_6 + anf_app_5 let anon_4 x f= - let anf_app_7=(x x) + let anf_app_6=(x x) in - let anf_app_8=(anf_app_7 f) + let anf_app_7=(anf_app_6 f) in - anf_app_8 + anf_app_7 let anon_3 x= - let anf_app_9=(anon_4 x) + let anf_app_8=(anon_4 x) in - let anf_app_10=(f anf_app_9) + let anf_app_9=(f anf_app_8) in - anf_app_10 + anf_app_9 $ dune exec anf_conv_test < manytests/typed/001fac.ml let fac n= let anf_op_1=(n<=1) @@ -444,15 +384,11 @@ ) else ( let anf_op_6=(n-1) in - let anf_app_7=(fac_cps anf_op_6) - in - let anf_app_8=(anon_1 n) + let anf_app_7=(anon_1 n k) in - let anf_app_9=(anf_app_8 k) + let anf_app_8=(fac_cps anf_op_6 anf_app_7) in - let anf_app_10=(anf_app_7 anf_app_9) - in - anf_app_10) + anf_app_8) in anf_if_4 @@ -460,15 +396,13 @@ print_int let main = - let anf_app_11=(fac_cps 4) - in - let anf_app_12=(anon_2 ) + let anf_app_9=(anon_2 ) in - let anf_app_13=(anf_app_11 anf_app_12) + let anf_app_10=(fac_cps 4 anf_app_9) in - let anf_app_14=(print_int anf_app_13) + let anf_app_11=(print_int anf_app_10) in - let ()=anf_app_14 + let ()=anf_app_11 in 0 $ dune exec anf_conv_test < manytests/typed/003fib.ml @@ -489,65 +423,49 @@ then ( b ) else ( - let anf_app_5=(fib_acc b) - in - let anf_app_6=(ab a) - in - let anf_app_7=(anf_app_6 b) - in - let anf_app_8=(anf_app_7 n) + let anf_app_5=(ab a b n) in - let anf_app_9=(anf_app_5 anf_app_8) + let anf_app_6=(n1 a b n) in - let anf_app_10=(n1 a) + let anf_app_7=(fib_acc b anf_app_5 anf_app_6) in - let anf_app_11=(anf_app_10 b) - in - let anf_app_12=(anf_app_11 n) - in - let anf_app_13=(anf_app_9 anf_app_12) - in - anf_app_13) + anf_app_7) in anf_if_4 let fib n= - let anf_op_14=(n<2) + let anf_op_8=(n<2) in - let anf_if_15=if (anf_op_14) + let anf_if_9=if (anf_op_8) then ( n ) else ( - let anf_op_16=(n-1) + let anf_op_10=(n-1) in - let anf_op_17=(n-2) + let anf_op_11=(n-2) in - let anf_app_18=(fib anf_op_17) + let anf_app_12=(fib anf_op_11) in - let anf_op_19=(anf_op_16+anf_app_18) + let anf_op_13=(anf_op_10+anf_app_12) in - let anf_app_20=(fib anf_op_19) + let anf_app_14=(fib anf_op_13) in - anf_app_20) + anf_app_14) in - anf_if_15 + anf_if_9 let main = - let anf_app_21=(fib_acc 0) + let anf_app_15=(fib_acc 0 1 4) in - let anf_app_22=(anf_app_21 1) + let anf_app_16=(print_int anf_app_15) in - let anf_app_23=(anf_app_22 4) + let ()=anf_app_16 in - let anf_app_24=(print_int anf_app_23) + let anf_app_17=(fib 4) in - let ()=anf_app_24 + let anf_app_18=(print_int anf_app_17) in - let anf_app_25=(fib 4) - in - let anf_app_26=(print_int anf_app_25) - in - let ()=anf_app_26 + let ()=anf_app_18 in 0 $ dune exec anf_conv_test < manytests/typed/004manyargs.ml @@ -675,13 +593,11 @@ let main = let anf_app_9=(fac ) in - let anf_app_10=(fix anf_app_9) - in - let anf_app_11=(anf_app_10 6) + let anf_app_10=(fix anf_app_9 6) in - let anf_app_12=(print_int anf_app_11) + let anf_app_11=(print_int anf_app_10) in - let ()=anf_app_12 + let ()=anf_app_11 in 0 $ dune exec anf_conv_test < manytests/typed/006partial.ml @@ -784,29 +700,27 @@ in let ()=anf_app_2 in - let anf_app_3=(anon_2 b) + let anf_app_3=(anon_2 b a) in - let anf_app_4=(anf_app_3 a) - in - anf_app_4 + anf_app_3 let foo a= - let anf_app_5=(print_int a) + let anf_app_4=(print_int a) in - let ()=anf_app_5 + let ()=anf_app_4 in - let anf_app_6=(anon_1 a) + let anf_app_5=(anon_1 a) in - anf_app_6 + anf_app_5 let main = - let anf_app_7=(foo 4) + let anf_app_6=(foo 4) in - let anf_app_8=(anf_app_7 8) + let anf_app_7=(anf_app_6 8) in - let anf_app_9=(anf_app_8 9) + let anf_app_8=(anf_app_7 9) in - let ()=anf_app_9 + let ()=anf_app_8 in 0 $ dune exec anf_conv_test << EOF @@ -827,21 +741,11 @@ anf_op_3 let g a c d= - let anf_app_4=(h c) - in - let anf_app_5=(anf_app_4 d) - in - let anf_app_6=(anf_app_5 a) - in - let anf_app_7=(anf_app_6 4) + let anf_app_4=(h c d a 4) in - anf_app_7 + anf_app_4 let f a= - let anf_app_8=(g a) - in - let anf_app_9=(anf_app_8 2) - in - let anf_app_10=(anf_app_9 3) + let anf_app_5=(g a 2 3) in - anf_app_10 + anf_app_5 diff --git a/slarnML/test/exec_test.t_ b/slarnML/test/exec_test.t_ index c9f1a97e84b2d1e56215e31c53369f5d528e1f33..43df86ad21093b6cee16dbd041a9cdc94994ff27 100644 GIT binary patch delta 16 YcmeyYcv*2n1=r+@e0H0!amlg)06_2tp#T5? delta 41 hcmcbt_*rp71($>&0|Xcvz-S0#vNn_5=5<`EYyhV^2MPcH diff --git a/slarnML/test/lambda_lifting_test.t b/slarnML/test/lambda_lifting_test.t index 51d779eed..e4c7b9884 100644 --- a/slarnML/test/lambda_lifting_test.t +++ b/slarnML/test/lambda_lifting_test.t @@ -7,9 +7,9 @@ > ;; > EOF let anon_1 n k n m =(((k*m)*n)) - let fack n k =(if ((n<=1)) then (n (n-1)) else (anon_1 n k n)) + let fack n k =(if ((n<=1)) then ((n (n-1))) else ((anon_1 n k n))) let anon_2 n x =(x) - let fac n =(fack n anon_2 n) + let fac n =((fack n (anon_2 n))) $ dune exec lambda_lifting_test << EOF > let f a= > let g c d = @@ -19,8 +19,8 @@ > ;; > EOF let h c d a e =((a*(c+(d*e)))) - let g a c d =(h c d a 4) - let f a =(g a 2 3) + let g a c d =((h c d a 4)) + let f a =((g a 2 3)) $ dune exec lambda_lifting_test << EOF > let f a b = > let g c = @@ -29,10 +29,10 @@ > g 3 > ;; > EOF - let anon_1 c a b x =((x*a (c*b))) - let h c a b =(anon_1 c a b) - let g a b c =(h c a b a) - let f a b =(g a b 3) + let anon_1 c a b x =((x*(a (c*b)))) + let h c a b =((anon_1 c a b)) + let g a b c =(((h c a b) a)) + let f a b =((g a b 3)) $ dune exec lambda_lifting_test << EOF > let f a = > let g a b= @@ -42,8 +42,8 @@ > ;; > EOF let h a a b c =((a*(b/c))) - let g a b =(h a a 2 3) - let f a =(g (1+0) a) + let g a b =((h a a 2 3)) + let f a =((g (1+0) a)) $ dune exec lambda_lifting_test << EOF > let f a = > let g b = a / b in @@ -53,7 +53,7 @@ > EOF let g a b =((a/b)) let h a c =((a*c)) - let f a =((h a 1+g a 2)) + let f a =(((h a 1)+(g a 2))) $ dune exec lambda_lifting_test << EOF > let f a = > let g = (fun x -> x) in @@ -62,28 +62,28 @@ > ;; > EOF let anon_1 a x =(x) - let g a =(anon_1 a) + let g a =((anon_1 a)) let anon_2 a x =((a*x)) - let h a =(anon_2 a) - let f a =((g a a+h a a)) + let h a =((anon_2 a)) + let f a =((((g a) a)+((h a) a))) $ 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 - let anon_1 n f n x =((x*f n)) - let fack n f =(if ((n<=1)) then (f 1) else (fack (n-1) anon_1 n f n)) + let anon_1 n f n x =((x*(f n))) + let fack n f =(if ((n<=1)) then ((f 1)) else ((fack (n-1) (anon_1 n f n)))) let anon_2 n x =(x) - let fac n =(fack n anon_2 n) + let fac n =((fack n (anon_2 n))) $ 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 - let fack n =(if ((n<1)) then (n) else ((n*fack (n-1)))) - let fac n =(fack n) + let fack n =(if ((n<1)) then (n) else ((n*(fack (n-1))))) + let fac n =((fack n)) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -93,58 +93,58 @@ > (g 2 3) > EOF let h c d a e =((a*(c+(d*e)))) - let g a c d =(h c d a 4) - let f a =(g a 2 3) + let g a c d =((h c d a 4)) + let f a =((g a 2 3)) $ dune exec lambda_lifting_test < manytests/do_not_type/001.ml - let recfac n =(if ((n<=1)) then (1) else ((n*fac (n-1)))) + let recfac n =(if ((n<=1)) then (1) else ((n*(fac (n-1))))) $ dune exec lambda_lifting_test < manytests/do_not_type/002if.ml let main =(if (true) then (1) else (false)) $ dune exec lambda_lifting_test < manytests/do_not_type/003occurs.ml - let anon_2 x f =(x x f) - let anon_1 f x =(f anon_2 x f) - let fix f =(anon_1 f) - let anon_4 x f =(x x f) - let anon_3 x =(f anon_4 x) + let anon_2 x f =(((x x) f)) + let anon_1 f x =((f (anon_2 x f))) + let fix f =((anon_1 f)) + let anon_4 x f =(((x x) f)) + let anon_3 x =((f (anon_4 x))) $ dune exec lambda_lifting_test < manytests/typed/001fac.ml - let fac n =(if ((n<=1)) then (1) else ((n*fac (n-1)))) - let main =(let () = (print_int fac 4 in 0)) + let fac n =(if ((n<=1)) then (1) else ((n*(fac (n-1))))) + let main =(let () = ((print_int (fac 4)) in 0)) $ dune exec lambda_lifting_test < manytests/typed/002fac.ml - let anon_1 n k p =(k (p*n)) - let fac_cps n k =(if ((n=1)) then (k 1) else (fac_cps (n-1) anon_1 n k)) + let anon_1 n k p =((k (p*n))) + let fac_cps n k =(if ((n=1)) then ((k 1)) else ((fac_cps (n-1) (anon_1 n k)))) let anon_2 print_int =(print_int) - let main =(let () = (print_int fac_cps 4 anon_2 in 0)) + let main =(let () = ((print_int (fac_cps 4 (anon_2 ))) in 0)) $ dune exec lambda_lifting_test < manytests/typed/003fib.ml let n1 a b n =((n-1)) let ab a b n =((a+b)) - let fib_acc a b n =(if ((n=1)) then (b) else (fib_acc b ab a b n n1 a b n)) - let 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))) + let fib_acc a b n =(if ((n=1)) then (b) else ((fib_acc b (ab a b n) (n1 a b n)))) + let 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 lambda_lifting_test < manytests/typed/004manyargs.ml let wrap f =(if ((1=1)) then (f) else (f)) - let a_0 a b c =(print_int a) - let b_0 a b c =(print_int b) - let c_0 a b c =(print_int c) + let a_0 a b c =((print_int a)) + let b_0 a b c =((print_int b)) + let c_0 a b c =((print_int c)) let test3 a b c =(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 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)))) + 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 lambda_lifting_test < manytests/typed/005fix.ml - let 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 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 lambda_lifting_test < manytests/typed/006partial.ml let anon_1 b foo =((foo+2)) let anon_2 b foo =((foo*10)) - let foo b =(if (b) then (anon_1 b) else (anon_2 b)) - let foo_0 x =(foo true foo false foo true foo false x) - let main =(let () = (print_int foo_0 11 in 0)) + let foo b =(if (b) then ((anon_1 b)) else ((anon_2 b))) + let foo_0 x =(((foo true) ((foo false) ((foo true) ((foo false) x))))) + let main =(let () = ((print_int (foo_0 11)) in 0)) $ dune exec lambda_lifting_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_0 = (foo 1 in let foo_0_2 = (foo_0 2 in let foo_0_2_4 = (foo_0_2 3 in let () = (print_int foo_0_2_4 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_0 = ((foo 1) in let foo_0_2 = ((foo_0 2) in let foo_0_2_4 = ((foo_0_2 3) in let () = ((print_int foo_0_2_4) in 0))))) $ dune exec lambda_lifting_test < manytests/typed/006partial3.ml - let anon_2 b a c =(print_int c) - let anon_1 a b =(let () = (print_int b in anon_2 b a)) - let foo a =(let () = (print_int a in anon_1 a)) - let main =(let () = (foo 4 8 9 in 0)) + let anon_2 b a c =((print_int c)) + let anon_1 a b =(let () = ((print_int b) in (anon_2 b a))) + let foo a =(let () = ((print_int a) in (anon_1 a))) + let main =(let () = ((((foo 4) 8) 9) in 0)) $ dune exec lambda_lifting_test << EOF > let f a = > let g c d = @@ -154,5 +154,5 @@ > (g 2 3) > EOF let h c d a e =((a*(c+(d*e)))) - let g a c d =(h c d a 4) - let f a =(g a 2 3) + let g a c d =((h c d a 4)) + let f a =((g a 2 3)) diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 292ea7cca..35cfa3073 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -30,10 +30,6 @@ > 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) diff --git a/slarnML/test/riscv64_instr_test.t b/slarnML/test/riscv64_instr_test.t index 5faa4f051..2d3e7e7c3 100644 --- a/slarnML/test/riscv64_instr_test.t +++ b/slarnML/test/riscv64_instr_test.t @@ -44,70 +44,45 @@ addi sp,sp,80 ret g: - addi sp,sp,-176 - sd ra,160(sp) - sd s0,152(sp) - addi s0,sp,176 - sd a2,-176(s0) - sd a1,-168(s0) - sd a0,-160(s0) + addi sp,sp,-80 + sd ra,64(sp) + sd s0,56(sp) + addi s0,sp,80 + sd a2,-80(s0) + sd a1,-72(s0) + sd a0,-64(s0) lui a0,%hi(h) addi a0,a0,%lo(h) - ld a3,-168(s0) - li a2,1 + li a6,4 + ld a5,-64(s0) + ld a4,-80(s0) + ld a3,-72(s0) + li a2,4 li a1,4 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - ld a3,-176(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-40(s0) - ld a3,-160(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-48(s0) - ld a0,-48(s0) - li a3,4 - li a2,1 - li a1,0 call part_app mv a0,a0 - ld ra,160(sp) - ld s0,152(sp) - addi sp,sp,176 + ld ra,64(sp) + ld s0,56(sp) + addi sp,sp,80 ret f: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - sd a0,-128(s0) + addi sp,sp,-64 + sd ra,48(sp) + sd s0,40(sp) + addi s0,sp,64 + sd a0,-64(s0) lui a0,%hi(g) addi a0,a0,%lo(g) - ld a3,-128(s0) - li a2,1 + li a5,3 + li a4,2 + ld a3,-64(s0) + li a2,3 li a1,3 - call part_app - sd a0,-32(s0) - ld a0,-32(s0) - li a3,2 - li a2,1 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-40(s0) - li a3,3 - li a2,1 - li a1,0 call part_app mv a0,a0 - ld ra,112(sp) - ld s0,104(sp) - addi sp,sp,128 + ld ra,48(sp) + ld s0,40(sp) + addi sp,sp,64 ret $ dune exec riscv64_instr_test << EOF > let fac n = @@ -156,62 +131,47 @@ addi sp,sp,96 ret fack: - addi sp,sp,-256 - sd ra,240(sp) - sd s0,232(sp) - addi s0,sp,256 - sd a1,-256(s0) - sd a0,-248(s0) + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a1,-160(s0) + sd a0,-152(s0) li t0,1 ble a0,t0,.tag_anf_op_3 li t1,1 sub t2,a0,t1 sd t2,-32(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-32(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-40(s0) lui a0,%hi(anon_1) addi a0,a0,%lo(anon_1) - ld a3,-248(s0) - li a2,1 + mv a5,a3 + ld a4,-160(s0) + ld a3,-152(s0) + li a2,3 li a1,4 call part_app - sd a0,-48(s0) - ld a0,-48(s0) - ld a3,-256(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-56(s0) - ld a0,-56(s0) - ld a3,-248(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-64(s0) - ld a0,-40(s0) - ld a3,-64(s0) - li a2,1 - li a1,0 + sd a0,-40(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a4,-40(s0) + ld a3,-32(s0) + li a2,2 + li a1,2 call part_app j .tag_anf_op_3_t .tag_anf_op_3: - sd a0,-72(s0) - ld a0,-256(s0) + sd a0,-48(s0) + ld a0,-160(s0) li a3,1 li a2,1 li a1,0 call part_app .tag_anf_op_3_t: - sd a0,-80(s0) + sd a0,-56(s0) mv a0,a0 - ld ra,240(sp) - ld s0,232(sp) - addi sp,sp,256 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret anon_2: addi sp,sp,-32 @@ -226,34 +186,29 @@ addi sp,sp,32 ret fac: - addi sp,sp,-128 - sd ra,112(sp) - sd s0,104(sp) - addi s0,sp,128 - sd a0,-128(s0) - lui a0,%hi(fack) - addi a0,a0,%lo(fack) - ld a3,-128(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-32(s0) + addi sp,sp,-96 + sd ra,80(sp) + sd s0,72(sp) + addi s0,sp,96 + sd a0,-96(s0) lui a0,%hi(anon_2) addi a0,a0,%lo(anon_2) - ld a3,-128(s0) + ld a3,-96(s0) li a2,1 li a1,2 call part_app - sd a0,-40(s0) - ld a0,-32(s0) - ld a3,-40(s0) - li a2,1 - li a1,0 + sd a0,-32(s0) + lui a0,%hi(fack) + addi a0,a0,%lo(fack) + ld a4,-32(s0) + ld a3,-96(s0) + li a2,2 + li a1,2 call part_app mv a0,a0 - ld ra,112(sp) - ld s0,104(sp) - addi sp,sp,128 + ld ra,80(sp) + ld s0,72(sp) + addi sp,sp,96 ret $ dune exec riscv64_instr_test << EOF > let f a = @@ -613,56 +568,46 @@ 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,-224(s0) - sd a0,-216(s0) + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a1,-160(s0) + sd a0,-152(s0) li t0,1 beq a0,t0,.tag_anf_op_3 li t1,1 sub t2,a0,t1 sd t2,-32(s0) - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - ld a3,-32(s0) - li a2,1 - li a1,2 - call part_app - sd a0,-40(s0) lui a0,%hi(anon_1) addi a0,a0,%lo(anon_1) - ld a3,-216(s0) - li a2,1 + ld a4,-160(s0) + ld a3,-152(s0) + li a2,2 li a1,3 call part_app - sd a0,-48(s0) - ld a0,-48(s0) - ld a3,-224(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-56(s0) - ld a0,-40(s0) - ld a3,-56(s0) - li a2,1 - li a1,0 + 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 j .tag_anf_op_3_t .tag_anf_op_3: - sd a0,-64(s0) - ld a0,-224(s0) + sd a0,-48(s0) + ld a0,-160(s0) li a3,1 li a2,1 li a1,0 call part_app .tag_anf_op_3_t: - sd a0,-72(s0) + sd a0,-56(s0) mv a0,a0 - ld ra,208(sp) - ld s0,200(sp) - addi sp,sp,224 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret anon_2: addi sp,sp,-32 @@ -676,41 +621,36 @@ addi sp,sp,32 ret main2: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 - lui a0,%hi(fac_cps) - addi a0,a0,%lo(fac_cps) - li a3,4 - li a2,1 - li a1,2 - call part_app - sd a0,-32(s0) + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 lui a0,%hi(anon_2) addi a0,a0,%lo(anon_2) li a2,0 li a1,1 call part_app - sd a0,-40(s0) - ld a0,-32(s0) - ld a3,-40(s0) - li a2,1 - li a1,0 + sd a0,-32(s0) + lui a0,%hi(fac_cps) + addi a0,a0,%lo(fac_cps) + ld a4,-32(s0) + li a3,4 + li a2,2 + li a1,2 call part_app - sd a0,-48(s0) + sd a0,-40(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-48(s0) + ld a3,-40(s0) li a2,1 li a1,1 call part_app - sd a0,-56(s0) + sd a0,-48(s0) li t0,0 mv a0,t0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 ret $ dune exec riscv64_instr_test < manytests/typed/003fib.ml @@ -764,81 +704,51 @@ addi sp,sp,48 ret fib_acc: - addi sp,sp,-352 - sd ra,336(sp) - sd s0,328(sp) - addi s0,sp,352 - sd a2,-352(s0) - sd a1,-344(s0) - sd a0,-336(s0) + addi sp,sp,-160 + sd ra,144(sp) + sd s0,136(sp) + addi s0,sp,160 + sd a2,-160(s0) + sd a1,-152(s0) + sd a0,-144(s0) li t0,1 beq a2,t0,.tag_anf_op_3 - lui a0,%hi(fib_acc) - addi a0,a0,%lo(fib_acc) - ld a3,-344(s0) - li a2,1 - li a1,3 - call part_app - sd a0,-32(s0) lui a0,%hi(ab) addi a0,a0,%lo(ab) - ld a3,-336(s0) - li a2,1 + ld a5,-160(s0) + ld a4,-152(s0) + ld a3,-144(s0) + li a2,3 li a1,3 call part_app - sd a0,-40(s0) - ld a0,-40(s0) - ld a3,-344(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-48(s0) - ld a0,-48(s0) - ld a3,-352(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-56(s0) - ld a0,-32(s0) - ld a3,-56(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-64(s0) + sd a0,-32(s0) lui a0,%hi(n1) addi a0,a0,%lo(n1) - ld a3,-336(s0) - li a2,1 + ld a5,-160(s0) + ld a4,-152(s0) + ld a3,-144(s0) + li a2,3 li a1,3 call part_app - sd a0,-72(s0) - ld a0,-72(s0) - ld a3,-344(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-80(s0) - ld a0,-80(s0) - ld a3,-352(s0) - li a2,1 - li a1,0 - call part_app - sd a0,-88(s0) - ld a0,-64(s0) - ld a3,-88(s0) - li a2,1 - li a1,0 + sd a0,-40(s0) + lui a0,%hi(fib_acc) + addi a0,a0,%lo(fib_acc) + ld a5,-40(s0) + ld a4,-32(s0) + ld a3,-152(s0) + li a2,3 + li a1,3 call part_app j .tag_anf_op_3_t .tag_anf_op_3: - ld t0,-344(s0) - sd a0,-96(s0) + ld t0,-152(s0) + sd a0,-48(s0) mv a0,t0 .tag_anf_op_3_t: mv a0,a0 - ld ra,336(sp) - ld s0,328(sp) - addi sp,sp,352 + ld ra,144(sp) + ld s0,136(sp) + addi sp,sp,160 ret fib: addi sp,sp,-128 @@ -847,7 +757,7 @@ addi s0,sp,128 sd a0,-128(s0) li t0,2 - blt a0,t0,.tag_anf_op_14 + blt a0,t0,.tag_anf_op_8 li t1,1 sub t2,a0,t1 li t3,2 @@ -870,68 +780,58 @@ li a2,1 li a1,1 call part_app - j .tag_anf_op_14_t - .tag_anf_op_14: + j .tag_anf_op_8_t + .tag_anf_op_8: ld t3,-128(s0) sd a0,-64(s0) mv a0,t3 - .tag_anf_op_14_t: + .tag_anf_op_8_t: mv a0,a0 ld ra,120(sp) ld s0,112(sp) addi sp,sp,128 ret main2: - addi sp,sp,-224 - sd ra,216(sp) - sd s0,208(sp) - addi s0,sp,224 + addi sp,sp,-160 + sd ra,152(sp) + sd s0,144(sp) + addi s0,sp,160 lui a0,%hi(fib_acc) addi a0,a0,%lo(fib_acc) + li a5,4 + li a4,1 li a3,0 - li a2,1 + li a2,3 li a1,3 call part_app sd a0,-32(s0) - ld a0,-32(s0) - li a3,1 - li a2,1 - li a1,0 - call part_app - sd a0,-40(s0) - ld a0,-40(s0) - li a3,4 - li a2,1 - 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) + ld a3,-32(s0) li a2,1 li a1,1 call part_app - sd a0,-56(s0) - sd a0,-64(s0) + sd a0,-40(s0) + sd a0,-48(s0) lui a0,%hi(fib) addi a0,a0,%lo(fib) li a3,4 li a2,1 li a1,1 call part_app - sd a0,-72(s0) + sd a0,-56(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-72(s0) + ld a3,-56(s0) li a2,1 li a1,1 call part_app - sd a0,-80(s0) + sd a0,-64(s0) li t0,0 mv a0,t0 - ld ra,216(sp) - ld s0,208(sp) - addi sp,sp,224 + ld ra,152(sp) + ld s0,144(sp) + addi sp,sp,160 ret $ dune exec riscv64_instr_test < manytests/typed/004manyargs.ml @@ -1279,10 +1179,10 @@ addi sp,sp,96 ret main2: - addi sp,sp,-160 - sd ra,144(sp) - sd s0,136(sp) - addi s0,sp,160 + addi sp,sp,-128 + sd ra,112(sp) + sd s0,104(sp) + addi s0,sp,128 lui a0,%hi(fac) addi a0,a0,%lo(fac) li a2,0 @@ -1291,29 +1191,24 @@ sd a0,-32(s0) lui a0,%hi(fix) addi a0,a0,%lo(fix) + li a4,6 ld a3,-32(s0) - li a2,1 + li a2,2 li a1,2 call part_app sd a0,-40(s0) - ld a0,-40(s0) - li a3,6 - li a2,1 - 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) + ld a3,-40(s0) li a2,1 li a1,1 call part_app - sd a0,-56(s0) + sd a0,-48(s0) li t0,0 mv a0,t0 - ld ra,144(sp) - ld s0,136(sp) - addi sp,sp,160 + ld ra,112(sp) + ld s0,104(sp) + addi sp,sp,128 ret $ dune exec riscv64_instr_test < manytests/typed/006partial.ml @@ -1625,15 +1520,15 @@ addi sp,sp,80 ret anon_1: - addi sp,sp,-144 - sd ra,128(sp) - sd s0,120(sp) - addi s0,sp,144 - sd a1,-144(s0) - sd a0,-136(s0) + addi sp,sp,-112 + sd ra,96(sp) + sd s0,88(sp) + addi s0,sp,112 + sd a1,-112(s0) + sd a0,-104(s0) lui a0,%hi(print_int) addi a0,a0,%lo(print_int) - ld a3,-144(s0) + ld a3,-112(s0) li a2,1 li a1,1 call part_app @@ -1641,20 +1536,15 @@ sd a0,-40(s0) lui a0,%hi(anon_2) addi a0,a0,%lo(anon_2) - ld a3,-144(s0) - li a2,1 + ld a4,-104(s0) + ld a3,-112(s0) + li a2,2 li a1,3 - call part_app - sd a0,-48(s0) - ld a0,-48(s0) - ld a3,-136(s0) - li a2,1 - li a1,0 call part_app mv a0,a0 - ld ra,128(sp) - ld s0,120(sp) - addi sp,sp,144 + ld ra,96(sp) + ld s0,88(sp) + addi sp,sp,112 ret foo: addi sp,sp,-96 From 21c02f894ac1eb6d32b647f92a4630323b5d027b Mon Sep 17 00:00:00 2001 From: Ivan Date: Thu, 24 Apr 2025 17:00:15 +0300 Subject: [PATCH 44/45] Add ordering --- slarnML/lib/parser/parser.ml | 10 ++++++---- slarnML/test/exec_test.t_ | Bin 4307 -> 4921 bytes slarnML/test/parser_tests.t | 3 +++ 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/slarnML/lib/parser/parser.ml b/slarnML/lib/parser/parser.ml index 2eaae6ad8..ee0fed7ea 100644 --- a/slarnML/lib/parser/parser.ml +++ b/slarnML/lib/parser/parser.ml @@ -88,8 +88,10 @@ let tuple el = (el <* skip_empty)) ;; -let arguments = tuple identifier <|> many identifier -let arguments1 = tuple identifier <|> many1 identifier +let unit = skip_empty *> (parens @@ (string "" *> return "()")) + +let arguments = tuple (identifier <|> unit) <|> many (identifier <|> unit) +let arguments1 = tuple (identifier <|> unit) <|> many1 (identifier <|> unit) let declaration is_rec = skip_empty *> identifier @@ -349,7 +351,7 @@ 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 "()" +(* let%test _ = parse_fail "()" *) (*== Test parse argiments ==*) (* TODO: arguments can accept Const(CUnit, CInt, CBool) and Id(string) *) @@ -364,7 +366,7 @@ 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 "()" +(* let%test _ = parse_fail "()" *) (*== Test parse declaration ==*) let parse_ok flag = test_ok @@ declaration flag diff --git a/slarnML/test/exec_test.t_ b/slarnML/test/exec_test.t_ index 43df86ad21093b6cee16dbd041a9cdc94994ff27..f57b2be7d2520a08894c7332164bc04c0b40579c 100644 GIT binary patch delta 139 zcmcbtxKnLIIEO}XYI<&JUP)p}W`3SRT4HHViGoIQeo?AIN@;FEYKkV8fB)1c diff --git a/slarnML/test/parser_tests.t b/slarnML/test/parser_tests.t index 35cfa3073..9627fdbf2 100644 --- a/slarnML/test/parser_tests.t +++ b/slarnML/test/parser_tests.t @@ -132,3 +132,6 @@ > (g 2 3) > EOF let f a=(let g c d=(let h e=((a*(c+(d*e)))) in ((h 4))) in ((g 2 3))) + $ dune exec parser_test < manytests/typed/007order.ml + let _start () () a () b _c () d __=(let ()=((print_int (a+b))) in (let ()=((print_int __)) in ((((a*b)/_c)+d)))) + let main=((print_int (_start (print_int 1) (print_int 2) 3 (print_int 4) 100 1000 (print_int (-1)) 10000 (-555555)))) From b380447016d59f71d45dedfd898b01c8e64c5639 Mon Sep 17 00:00:00 2001 From: Ivan Date: Thu, 24 Apr 2025 17:01:46 +0300 Subject: [PATCH 45/45] Format --- slarnML/lib/parser/parser.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/slarnML/lib/parser/parser.ml b/slarnML/lib/parser/parser.ml index ee0fed7ea..8fd3af65f 100644 --- a/slarnML/lib/parser/parser.ml +++ b/slarnML/lib/parser/parser.ml @@ -89,7 +89,6 @@ let tuple el = ;; let unit = skip_empty *> (parens @@ (string "" *> return "()")) - let arguments = tuple (identifier <|> unit) <|> many (identifier <|> unit) let arguments1 = tuple (identifier <|> unit) <|> many1 (identifier <|> unit)