/
mstack.elc
27 lines (22 loc) · 3.42 KB
/
mstack.elc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
;ELC
;;; Compiled by toups@deluge on Tue Aug 30 14:21:42 2011
;;; from file /home/toups/elisp/utils/mstack.el
;;; in Emacs version 23.2.1
;;; with all optimizations.
;;; This file uses dynamic docstrings, first added in Emacs 19.29.
;;; This file does not contain utf-8 non-ASCII characters,
;;; and so can be loaded in Emacs versions earlier than 23.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(byte-code "\300\301!\210\300\302!\207" [require monads utils] 2)
(defalias 'get-options #[(options) "A\207" [options] 1])
(defalias 'options\? #[(mb-options) "<\205 @\301=\207" [mb-options Options] 2])
(defalias 'list->options #[(lst) "\301B\207" [lst Options] 2])
(defalias 'options-bind #[(v f) "\303!\304\305\306\303\n\" \"!)\207" [v options f get-options list->options mapcat comp] 5])
#@57 Options monad - just window dressing on the list monad.
(defvar options-monad (tbl! :m-bind 'options-bind :m-return #[(v) "\302\301JC!)\207" [v #1=#:--cl-v-- list->options] 2]) (#$ . 900))
(defalias 'fpush #[(x stack) " B\207" [x stack] 2])
(defalias 'fdrop #[(stack) "A\207" [stack] 1])
(defalias 'mfpush #[(mitems mstack) "\303\304\" \n\"\207" [options-monad mitems mstack m-lift-into2 fpush] 3])
(defalias 'mfdrop #[(mstack) "\302\303\" !\207" [options-monad mstack m-lift-into1 fdrop] 3])
(byte-code "\306\307\310\311\"!\210\312 \313\"\314 !\204 \315\316!\210\317\320!\211\205\" \320K \321\216\320\322M\210\317\323!\211 \2053 \323K \324\216\323\325M\210\317\326!\211 !\205F \326K \"\327\216\326\330M\210\317\331!\211 #\205Y \331K $\332\216\331\333M\210\320\334\335\"\210.\336\337!\207" [options-monad current-monad m-zero #1=#:--cl-letf-bound-- #2=#:--cl-letf-save-- #3=#:--cl-letf-bound-- mfdrop mfpush (Options a b c) (Options nil (a) (a a)) tbl :m-zero monad\? error "Expected a monad in an mlet or similar form. \nA monad is a hash table with m-return and m-bind forms." fboundp m-bind ((byte-code "\203 \302 M\210\202 \303\302!\210\302\207" [#1# #2# m-bind fmakunbound] 2)) #[(v f) "\303\304\" \n\"\207" [current-monad v f tbl :m-bind] 3] m-return ((byte-code "\203 \302 M\210\202 \303\302!\210\302\207" [#3# #4=#:--cl-letf-save-- m-return fmakunbound] 2)) #[(v) "\302\303\" !\207" [current-monad v tbl :m-return] 3] >>= ((byte-code "\203 \302 M\210\202 \303\302!\210\302\207" [#5=#:--cl-letf-bound-- #6=#:--cl-letf-save-- >>= fmakunbound] 2)) #[(v f) "\303\304\" \n\"\207" [current-monad v f tbl :m-bind] 3] m-plus ((byte-code "\203 \302 M\210\202 \303\302!\210\302\207" [#7=#:--cl-letf-bound-- #8=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] (Options 1 2 3) #[(&rest #9=#:G55818) "G\304 \305\"\2032 \306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316\317\320 D\320\nD\321\257E\"*\2027 \322\323 \314#)\207" [#9# #:G55819 #:--cl-lambda-seq-as-sym55824-- #:--cl-x-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym55824--" "--x--" 0 m-bind (Options 4 5 6) lambda (&rest --cl-rest--) apply #[(#10=#:G55856 #:G55857 &rest #11=#:G55845) "G\305 \306\"\203 \302J\307\234\fJ\303J*D\202 \310\311 \312#)\207" [#11# #:G55846 #:--cl-lambda-seq-as-sym55851-- #:--cl-y-- #10# arity-match (1 exactly) 0 error #12="Unable to find an arity match for %d args in fn %s." lambda] 4] quote --cl-rest-- error #12#] 10] get-options (Options a b c) #4# #5# #6# #7# #8#] 5)