miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Inline array? and len, add PicoLisp fib & fib-let benchmarks

Browse Source
This commit is contained in:
Nathan Braswell
2022-07-02 23:49:47 -04:00
parent 07a25c8c59
commit ace81e362e
6 changed files with 88 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
flake.nix
View File

@@ -81,6 +81,7 @@
ocaml ocaml
jdk jdk
swift swift
picolisp
]; ];
}; };
} }

1
koka_bench/CMakeLists.txt
View File

@@ -18,3 +18,4 @@ add_subdirectory(swift)
add_subdirectory(python) add_subdirectory(python)
add_subdirectory(scheme) add_subdirectory(scheme)
add_subdirectory(picolisp)

22
koka_bench/picolisp/CMakeLists.txt Normal file
View File

@@ -0,0 +1,22 @@
set(copy_wrapper "../../copy_wrapper.sh")
set(sources picolisp-fib.l picolisp-fib-let.l)
foreach (source IN LISTS sources)
get_filename_component(name "${source}" NAME_WE)
set(out_dir "${CMAKE_CURRENT_BINARY_DIR}/out/bench")
set(out_path "${out_dir}/${name}")
add_custom_command(
OUTPUT ${out_path}
COMMAND ${copy_wrapper} "${CMAKE_CURRENT_SOURCE_DIR}/${source}" ${out_dir} ${name}
DEPENDS ${source}
VERBATIM)
add_custom_target(update-${name} ALL DEPENDS "${out_path}")
add_executable(${name}-exe IMPORTED)
set_target_properties(${name}-exe PROPERTIES IMPORTED_LOCATION "${out_path}")
endforeach ()

15
koka_bench/picolisp/picolisp-fib-let.l Executable file
View File

@@ -0,0 +1,15 @@
#!/usr/bin/env bash
#{
# Thanks to http://rosettacode.org/wiki/Multiline_shebang#PicoLisp
exec pil $0 $1
# }#
(de fib (N) (cond ((= 0 N) 1)
((= 1 N) 1)
(1 (let (A (fib (- N 1))
B (fib (- N 2))
) (+ A B)))))
(bye (println (fib (car (str (opt))))))

13
koka_bench/picolisp/picolisp-fib.l Executable file
View File

@@ -0,0 +1,13 @@
#!/usr/bin/env bash
#{
# Thanks to http://rosettacode.org/wiki/Multiline_shebang#PicoLisp
exec pil $0 $1
# }#
(de fib (n) (cond ((= 0 n) 1)
((= 1 n) 1)
(1 (+ (fib (- n 1)) (fib (- n 2))))))
(bye (println (fib (car (str (opt))))))

42
partial_eval.scm
View File

@@ -1793,12 +1793,12 @@
(set_wrap_code (lambda (level func) (i64.or (i64.shl level (i64.const 4)) (i64.and func (i64.const -17))))) (set_wrap_code (lambda (level func) (i64.or (i64.shl level (i64.const 4)) (i64.and func (i64.const -17)))))
(is_wrap_code (lambda (level func) (i64.eq (i64.const (<< level 4)) (i64.and func (i64.const #b10000))))) (is_wrap_code (lambda (level func) (i64.eq (i64.const (<< level 4)) (i64.and func (i64.const #b10000)))))
(needes_de_code (lambda (func) (i64.ne (i64.const 0) (i64.and func (i64.const #b100000))))) (needes_de_code (lambda (func) (i64.ne (i64.const 0) (i64.and func (i64.const #b100000)))))
(extract_usede_code (lambda (x) (i32.and (i32.const #b1) (i32.wrap_i64 (i64.shr_u x (i64.const 5)))))) (extract_usede_code (lambda (x) (i32.and (i32.const #b1) (i32.wrap_i64 (i64.shr_u x (i64.const 5))))))
(extract_int_code (lambda (x) (i64.shr_s x (i64.const 4)))) (extract_int_code (lambda (x) (i64.shr_s x (i64.const 4))))
(extract_int_code_i32 (lambda (x) (i32.wrap_i64 (extract_int_code x)))) (extract_int_code_i32 (lambda (x) (i32.wrap_i64 (extract_int_code x))))
(extract_ptr_code (lambda (bytes) (i32.wrap_i64 (i64.shr_u bytes (i64.const 32))))) (extract_ptr_code (lambda (bytes) (i32.wrap_i64 (i64.shr_u bytes (i64.const 32)))))
(extract_size_code (lambda (bytes) (i32.wrap_i64 (i64.and (i64.const #xFFFFFFF) (extract_size_code (lambda (bytes) (i32.wrap_i64 (i64.and (i64.const #xFFFFFFF) (i64.shr_u bytes (i64.const 4))))))
(i64.shr_u bytes (i64.const 4)))))) (extract_size_code_to_int (lambda (bytes) (i64.and (i64.const #xFFFFFFF0) bytes)))
(is_type_code (lambda (tag x) (i64.eq (i64.const tag) (i64.and (i64.const type_mask) x)))) (is_type_code (lambda (tag x) (i64.eq (i64.const tag) (i64.and (i64.const type_mask) x))))
@@ -4908,6 +4908,23 @@
(single_num_type_check (idx param_codes 0)) (single_num_type_check (idx param_codes 0))
(slice param_codes 1 -1)) nil ctx))) (slice param_codes 1 -1)) nil ctx)))
)) ))
(gen_pred_impl (lambda (tag needs_drop)
(dlet (((param_codes err ctx _) (compile_params false ctx false))
(_ (true_print "doing an array? inline!"))
)
(mif err (array nil nil (str err " from function params in call to comb " (str_strip c)) ctx)
(array nil (concat
(idx param_codes 0)
(local.set '$prim_tmp_a)
(_if '$is_pred '(result i64)
(i64.eq (i64.const tag) (i64.and (i64.const type_mask) (local.get '$prim_tmp_a)))
(then (i64.const true_val))
(else (i64.const false_val))
)
(mif needs_drop (generate_drop (local.get '$prim_tmp_a)) (array))
) nil ctx)))
))
(gen_cmp_impl (lambda (lt_case eq_case gt_case) (gen_cmp_impl (lambda (lt_case eq_case gt_case)
(dlet (((param_codes err ctx _) (compile_params false ctx false))) (dlet (((param_codes err ctx _) (compile_params false ctx false)))
(mif err (array nil nil (str err " from function params in call to comb " (str_strip c)) ctx) (mif err (array nil nil (str err " from function params in call to comb " (str_strip c)) ctx)
@@ -5005,6 +5022,9 @@
(_ (true_print "made eq_code")) (_ (true_print "made eq_code"))
) (array nil eq_code nil ctx)))) ) (array nil eq_code nil ctx))))
(dlet ((_ (true_print "missed better = " parameter_types))) (gen_cmp_impl false_val true_val false_val)))) (dlet ((_ (true_print "missed better = " parameter_types))) (gen_cmp_impl false_val true_val false_val))))
((and (prim_comb? func_value) (= (.prim_comb_sym func_value) 'array?) (= 1 num_params)) (gen_pred_impl array_tag true))
; inline idx if we have the type+len of array and idx is a constant ; inline idx if we have the type+len of array and idx is a constant
((and (prim_comb? func_value) (= (.prim_comb_sym func_value) 'idx) (= 2 num_params) ((and (prim_comb? func_value) (= (.prim_comb_sym func_value) 'idx) (= 2 num_params)
(idx parameter_types 0) (= 'arr (idx (idx parameter_types 0) 0)) (idx (idx parameter_types 0) 2) (idx parameter_types 0) (= 'arr (idx (idx parameter_types 0) 0)) (idx (idx parameter_types 0) 2)
@@ -5022,6 +5042,16 @@
nil) nil)
(array nil (true_str "bad constant offset into typed array")))) (array nil (true_str "bad constant offset into typed array"))))
) (array nil code err ctx))) ) (array nil code err ctx)))
; inline len if we have the type of array
((and (prim_comb? func_value) (= (.prim_comb_sym func_value) 'len) (= 1 num_params)
(idx parameter_types 0) (= 'arr (idx (idx parameter_types 0) 0))) (dlet (
(_ (true_print "inlining len LEN!!!"))
((param_codes err ctx _) (compile_params false ctx false))
(code (mif err nil
(concat (local.set '$prim_tmp_a (idx param_codes 0))
(extract_size_code_to_int (local.get '$prim_tmp_a))
(generate_drop (local.get '$prim_tmp_a)))))
) (array nil code err ctx)))