Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
2016-09-13 - Best Flex Matcher
; -*- lexical-binding: t; -*-
(require 'dash)
(require 's)
(require 'smex)
(require 'promise)
(require 'stream)
(require 'transducer )
(defconst fb/frame-rate (/ 30.0))
(defun fb/text-forward-permutations (text)
(letrec ((recurser
(lambda (sub-text)
(cond
((string-empty-p sub-text)
(stream-from-list (list "")))
((= (length sub-text) 1)
(stream-from-list (list sub-text "")))
((= (length sub-text) 2)
(stream-from-list
(list
""
(substring-no-properties sub-text 0 1)
(substring-no-properties sub-text 1 2)
sub-text)))
(t
(lexical-let* ((first-text
(substring-no-properties sub-text 0 1))
(rest-text
(substring-no-properties sub-text 1)))
(lexical-let* ((rest-permutations (funcall recurser rest-text))
(repeat-permutations (stream-copy 'empty rest-permutations))
(base-stream (car repeat-permutations))
(next-stream (cdr repeat-permutations)))
(stream-append
(transducer-transduce-stream
(transducer-map (-partial #'concat first-text))
base-stream)
next-stream))))))))
(funcall recurser text)))
(defun fb/stream-time-buffered (buffer-time stream)
(stream
(lambda (&rest args)
(lexical-let ((initial-value (apply stream args))
(done nil)
(now (current-time)))
(when (stream-start-value-p initial-value)
(setq initial-value (apply stream args)))
(if (stream-stop-value-p initial-value)
stream-stop
(promise
(lambda (res rej)
(lexical-let ((buffered-values (list initial-value))
(elapsed-time (float-time (time-subtract (current-time) now)))
(current-value initial-value))
(while (and (not done)
(< elapsed-time buffer-time))
(if (stream-stop-value-p current-value)
(setq done t)
(push current-value buffered-values)
(setq current-value (apply stream args))
(setq elapsed-time (float-time (time-subtract (current-time) now)))))
(funcall res (reverse buffered-values))))))))))
(defun fb/flex-match-text (text)
(concat
(regexp-quote (string (aref text 0)))
(mapconcat
(lambda (c)
(concat "[^" (string c) "]*"
(regexp-quote (string c))))
(substring text 1) "")))
(defun fb/function-symbol-stream ()
(transducer-transduce-stream
(transducer-map #'car)
(stream-from-list smex-cache)))
(defun fb/flex-match-symbol-stream (search symbol-stream)
(let ((re (fb/flex-match-text search)))
(transducer-transduce-stream
(transducer-composes
(transducer-map #'symbol-name)
(transducer-filter (-partial #'s-match re)))
symbol-stream)))
(defun fb/rate-flex-match (search target)
(transducer-transduce-stream
(transducer-composes
(transducer-map-indexed #'cons)
(transducer-first
(lambda (pair)
(string-equal (cdr pair) target))))
(fb/flex-match-symbol-stream
search
(fb/function-symbol-stream))))
(defun fb/function-symbol-p (name)
(not
(null
(stream-to-list
(transducer-transduce-stream
(transducer-first (-partial #'string-equal name))
(fb/function-symbol-stream))))))
(defun fb/rate-flex-matcher (search-size target)
(if (not (fb/function-symbol-p target))
(stream-stopped)
(lexical-let*
((rater (-rpartial #'fb/rate-flex-match target))
(rate-stream
(transducer-transduce-stream
(transducer-composes
(transducer-filter
(lambda (search)
(and
(not (string-empty-p search))
(<= (length search) search-size))))
(transducer-filter
(lambda (search)
(string-equal
(substring-no-properties search 0 1)
(substring-no-properties target 0 1))))
(transducer-filter
(lambda (search)
(not
(s-contains-p
"-"
search))))
(transducer-map
(lambda (search)
(cons
search
(stream-to-list (funcall rater search)))))
(transducer-filter
(lambda (pair)
(and
(not (null (cdr pair)))
(= 0 (car (car (cdr pair)))))))
(transducer-map
(lambda (pair)
(car pair))))
(fb/text-forward-permutations target))))
rate-stream)))
(defun fb/async-write-stream (file stream)
(with-temp-file file
(erase-buffer))
(letrec ((async-stream
(fb/stream-time-buffered
fb/frame-rate
stream))
(recurser
(lambda ()
(let ((value (funcall async-stream)))
(when (stream-start-value-p value)
(setq value (funcall async-stream)))
(if (stream-stop-value-p value)
(message "Done")
(promise-then
value
(lambda (values)
(when values
(append-to-file
(concat
(string-join
values
"\n")
"\n")
nil
file))
(run-with-idle-timer
fb/frame-rate
nil
recurser))))))))
(funcall recurser)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment