diff --git a/flake.nix b/flake.nix index 80ec2a0..99bfad6 100644 --- a/flake.nix +++ b/flake.nix @@ -81,6 +81,7 @@ ocaml jdk swift + picolisp ]; }; } diff --git a/koka_bench/CMakeLists.txt b/koka_bench/CMakeLists.txt index c69071f..3a9ed34 100644 --- a/koka_bench/CMakeLists.txt +++ b/koka_bench/CMakeLists.txt @@ -18,3 +18,4 @@ add_subdirectory(swift) add_subdirectory(python) add_subdirectory(scheme) +add_subdirectory(picolisp) diff --git a/koka_bench/picolisp/CMakeLists.txt b/koka_bench/picolisp/CMakeLists.txt new file mode 100644 index 0000000..dc9bda8 --- /dev/null +++ b/koka_bench/picolisp/CMakeLists.txt @@ -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 () + diff --git a/koka_bench/picolisp/picolisp-fib-let.l b/koka_bench/picolisp/picolisp-fib-let.l new file mode 100755 index 0000000..76bc72e --- /dev/null +++ b/koka_bench/picolisp/picolisp-fib-let.l @@ -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)))))) diff --git a/koka_bench/picolisp/picolisp-fib.l b/koka_bench/picolisp/picolisp-fib.l new file mode 100755 index 0000000..2b3977f --- /dev/null +++ b/koka_bench/picolisp/picolisp-fib.l @@ -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)))))) diff --git a/partial_eval.scm b/partial_eval.scm index 1fbfb83..fe786c0 100644 --- a/partial_eval.scm +++ b/partial_eval.scm @@ -1793,12 +1793,12 @@ (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))))) (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_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_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) - (i64.shr_u bytes (i64.const 4)))))) + (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_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_size_code (lambda (bytes) (i32.wrap_i64 (i64.and (i64.const #xFFFFFFF) (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)))) @@ -4908,6 +4908,23 @@ (single_num_type_check (idx param_codes 0)) (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) (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) @@ -5005,6 +5022,9 @@ (_ (true_print "made eq_code")) ) (array nil eq_code nil ctx)))) (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 ((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) @@ -5022,6 +5042,16 @@ nil) (array nil (true_str "bad constant offset into typed array")))) ) (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)))