Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
306 lines (263 sloc) 69.5 KB
;ELC
;;; Compiled by toups@deluge on Wed Dec 7 16:20:09 2011
;;; from file /home/toups/elisp/utils/monads.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!\210\300\303!\210\300\304!\207" [require cl utils defn recur] 2)
(defalias 'monad\? #[(m) "\301!\205\302\303\"\205\302\304\"\207" [m hash-table-p tbl :m-bind :m-return] 3])
(byte-code "\305\306\307!\211\310L\210\311\305\312\313\314\315\316 D\317FE\"\210\305\320\305!\210\n\210+\321\306\322!\211\323L\210\311\321\312\313\314\324\316 D\317FE\"\210\321\320\321!\210\f\210+\305\207" [currently-defining-defn #:--cl-Just-3031-- #:defunc-val3033 #:--cl-None-3044-- #:defunc-val3046 Just make-symbol "--Just-3031--" #[(&rest #1=#:G3035) "G\304 \305\"\203\302J\306\234\307\303J*D\202\310\311 \312#)\207" [#1# #:G3036 #:--cl-lambda-seq-as-sym3040-- #:--cl-x-- arity-match (1 exactly) 0 Just error #2="Unable to find an arity match for %d args in fn %s." lambda] 4] defalias lambda (&rest --cl-rest--) apply #[(#3=#:G3034 &rest #4=#:Just-args-3032) "\302J \"\207" [#3# #4# apply] 3] quote --cl-rest-- byte-compile None "--None-3044--" #[(&rest #5=#:G3048) "G\302 \303\"\203\210\304C\202\305\306 \307#)\207" [#5# #:G3049 arity-match (0 exactly) None error #2# lambda] 4] #[(#6=#:G3047 &rest #7=#:None-args-3045) "\302J \"\207" [#6# #7# apply] 3]] 9)
(defalias 'None\? #[(o) "<\205 @\301=\207" [o None] 2])
(byte-code "\303\304\305!\211\306L\210\307\303\310\311\312\313\314 D\315FE\"\210\303\316\303!\210\n\210+\303\207" [currently-defining-defn #:--cl-MaybeVal-3053-- #:defunc-val3055 MaybeVal make-symbol "--MaybeVal-3053--" #[(&rest #1=#:G3057) "G\305 \306\"\203*\302J\307\234\303J@\310=\203\311\312!\202&\303J\211A@)*\202/\311\313 \314#)\207" [#1# #:G3058 #:--cl-lambda-seq-as-sym3062-- #:--cl-x-- x arity-match (1 exactly) 0 None error "This should not happen, you tried to get the value of None" "Unable to find an arity match for %d args in fn %s." lambda] 5] defalias lambda (&rest --cl-rest--) apply #[(#2=#:G3056 &rest #3=#:MaybeVal-args-3054) "\302J \"\207" [#2# #3# apply] 3] quote --cl-rest-- byte-compile] 9)
(defalias 'Possibilities #[(&rest args) "\301B\207" [args Possibilities] 2])
(byte-code "\301\302\303\304\305$\301\207" [monad-possibilities tbl! :m-return #[(x) "\301!\207" [x Possibilities] 2] :m-bind #[(v f) "\304\305A\306\211 :\203 @\307!A B A\211\202\n \237+\"\207" [v #:--cl-var-- possibility #:--cl-var-- apply concat nil f] 5]] 5)
#@56 The MAYBE monad. See Just, None, None?, and MaybeVal.
(defvar monad-maybe (byte-code "\300\301\302 \303\304\305\306&\207" [tbl! :m-zero None :m-return #[(x) "\301!\207" [x Just] 2] :m-bind #[(v f) "@\302=\203 \207 \303!!\207" [v f None MaybeVal] 3]] 7) (#$ . 2849))
#@103 The (implicit) MAYBE monad. NIL indicates failure. MaybeVal is the identity. Just is the identity.
(defvar monad-maybe^i (tbl! :m-zero nil :m-return #[(x) "\207" [x] 1] :m-bind #[(v f) "\204\207 !\207" [v f] 2]) (#$ . 3129))
(defalias 'm-Error #[(arg) "\301D\207" [arg Error] 2])
(byte-code "\301B\302\301!\204\303\301\304\305\306\307\310$\"\210\301\207" [current-load-list monad-error default-boundp set-default tbl! :m-return #[(x) "\301!\207" [x Just] 2] :m-bind #[(v f) "@\302=\203 \207 \303!!\207" [v f Error MaybeVal] 3]] 7)
(defalias 'call-bind #[(monad mv mf) "\303\304 \n$ \207" [monad mv mf tbl :m-bind] 5])
(defalias 'call-return #[(monad val) "\302\303\" !\207" [monad val tbl :m-return] 3])
#@42 The identity monad - you know, for kids.
(defvar monad-id (tbl! :m-return #[(x) "\207" [x] 1] :m-bind #[(v f) " !\207" [f v] 2]) (#$ . 3860))
#@47 The identity is the current monad by default.
(defvar current-monad monad-id (#$ . 4010))
#@72 Monadic BIND. Unless dynamically shadowed, this is the identity BIND.
(defalias 'm-bind #[(v f) " !\207" [f v] 2 (#$ . 4106)])
#@76 Monadic return. Unless dynamically shadowed, this is the identity RETURN.
(defalias 'm-return #[(v) "\207" [v] 1 (#$ . 4241)])
#@108 The STATE monad. Constructs a function which takes a state and
transforms it out of other such functions.
(defvar monad-state (tbl! :m-return #[(&rest #1=#:G3066) "G\304 \305\"\203/\306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316 D\316\nD\317\257E*\2024\320\321 \312#)\207" [#1# #2=#:G3067 #3=#:--cl-lambda-seq-as-sym3071-- #4=#:--cl-x-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3071--" "--x--" 0 lambda #5=(&rest --cl-rest--) apply #[(#6=#:G3097 #7=#:G3098 &rest #8=#:G3088) "G\305 \306\"\203\302J\307\234\fJ\303J*D\202\310\311 \312#)\207" [#8# #9=#:G3089 #10=#:--cl-lambda-seq-as-sym3093-- #11=#:--cl-s-- #6# 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#] 8] :m-bind #[(&rest #13=#:G3075) "G\305 \306\"\203=\307\310!\211L\210\307\311!\211\nJ\312\234L\210\307\313!\211\nJ\314\234L\210\315\316\317\320\321\fD\321 D\321\nD\322\257E+\202B\323\324 \315#)\207" [#13# #14=#:G3076 #15=#:--cl-lambda-seq-as-sym3082-- #16=#:--cl-mv-- #17=#:--cl-f-- arity-match (2 exactly) make-symbol "--lambda-seq-as-sym3082--" "--mv--" 0 "--f--" 1 lambda #5# apply #[(#18=#:G3118 #19=#:G3119 #20=#:G3120 &rest #21=#:G3099) "G\306 \307\"\2038\302J\310\234\fJ\303J!C\305J\310\234 \311J\310\234 \311J\312\234\fJ\313J!\314J!.\202=\315\316 \317#)\207" [#21# #22=#:G3100 #23=#:--cl-lambda-seq-as-sym3104-- #24=#:--cl-s-- #19# #25=#:--cl-lambda-seq-as-sym3111-- arity-match (1 exactly) 0 #26=#:--cl-lambda-seq-as-sym3117-- 1 #27=#:--cl-val-- #28=#:--cl-new-state-- error #12# lambda #18#] 4] quote --cl-rest-- error #12#] 9]) (#$ . 4377))
#@75 The continuation monad. Construct a function which takes a continuation.
(defvar monad-cont (tbl! :m-return #[(&rest #1=#:G3121) "G\304 \305\"\203/\306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316 D\316\nD\317\257E*\2024\320\321 \312#)\207" [#1# #2=#:G3122 #3=#:--cl-lambda-seq-as-sym3126-- #4=#:--cl-v-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3126--" "--v--" 0 lambda #5=(&rest --cl-rest--) apply #[(#6=#:G3152 #7=#:G3153 &rest #8=#:G3143) "G\305 \306\"\203\302J\307\234\303J\fJ!*\202\310\311 \312#)\207" [#8# #9=#:G3144 #10=#:--cl-lambda-seq-as-sym3148-- #11=#:--cl-c-- #6# 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#] 8] :m-bind #[(&rest #13=#:G3130) "G\305 \306\"\203=\307\310!\211L\210\307\311!\211\nJ\312\234L\210\307\313!\211\nJ\314\234L\210\315\316\317\320\321\fD\321 D\321\nD\322\257E+\202B\323\324 \315#)\207" [#13# #14=#:G3131 #15=#:--cl-lambda-seq-as-sym3137-- #16=#:--cl-mv-- #17=#:--cl-mf-- arity-match (2 exactly) make-symbol "--lambda-seq-as-sym3137--" "--mv--" 0 "--mf--" 1 lambda #5# apply #[(#18=#:G3177 #19=#:G3178 #20=#:G3179 &rest #21=#:G3154) "G\306 \307\"\203<\310\311!\211L\210\310\312!\211\nJ\313\234L\210\fJ\314\315\316\317\320 D\320\nD\320 D\320\fD\320D\321\257E!*\202A\322\323 \314#)\207" [#21# #22=#:G3155 #23=#:--cl-lambda-seq-as-sym3159-- #24=#:--cl-c-- #19# #18# arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3159--" "--c--" 0 lambda #5# apply #[(#25=#:G3172 #26=#:G3173 #27=#:G3174 #28=#:G3175 #29=#:G3176 &rest #30=#:G3163) "G\305 \306\"\203\302J\307\234\310\303J!\fJ!*\202!\311\312 \313#)\207" [#30# #31=#:G3164 #32=#:--cl-lambda-seq-as-sym3168-- #33=#:--cl-v-- #25# arity-match (1 exactly) 0 mf error #12# lambda] 4] quote --cl-rest-- error #12# #20#] 12] quote --cl-rest-- error #12#] 9]) (#$ . 6052))
(byte-code "\306\307\310!\211\311L\210\312\306\313\314\315\316\317 D\320FE\"\210\306\321\306!\210\n\210+\322\307\323!\211\324L\210\312\322\313\314\315\325\317 D\320FE\"\210\322\321\322!\210\f\210+\326\307\327!\211\330L\210\312\326\313\314\315\331\317 D\320FE\"\210\326&\321\326!\210&\210+\332\307\333!\211'\334L\210\312\332\313\314\315\335\317'D\320FE\"\210\332(\321\332!\210(\210+\336\307\337!\211)\340L\210\312\336\313\314\315\341\317)D\320FE\"\210\336*\321\336!\210*\210+\342\307\343!\211+\344L\210\312\342\313\314\315\345\317+D\320FE\"\210\342,\321\342!\210,\210+\306\207" [currently-defining-defn #:--cl-call-bind-3180-- #:defunc-val3182 #:--cl-call-return-3206-- #:defunc-val3208 #:--cl-fetch-state-3232-- call-bind make-symbol "--call-bind-3180--" #[(&rest #1=#:G3184) "G\306 \307\"\203'\310\311\302J\"\302J\312\234\313\304J\314\"\315\305J\303J\",\202,\316\317 \320#)\207" [#1# #:G3185 #:--cl-lambda-seq-as-sym3192-- #:--cl-args-- #:--cl-lambda-as-symbol3199-- #:--cl-bind-- arity-match (1 +more) nthcdr-preserve-type 1 0 table-like-get :m-bind apply error #2="Unable to find an arity match for %d args in fn %s." lambda] 4] defalias lambda #3=(&rest --cl-rest--) apply #[(#4=#:G3183 &rest #5=#:call-bind-args-3181) "\302J \"\207" [#4# #5# apply] 3] quote --cl-rest-- byte-compile call-return "--call-return-3206--" #[(&rest #6=#:G3210) "G\306 \307\"\203'\310\311\302J\"\302J\312\234\313\304J\314\"\315\305J\303J\",\202,\316\317 \320#)\207" [#6# #:G3211 #:--cl-lambda-seq-as-sym3218-- #:--cl-args-- #:--cl-lambda-as-symbol3225-- #:--cl-return-- arity-match (1 +more) nthcdr-preserve-type 1 0 table-like-get :m-return apply error #2# lambda] 4] #[(#7=#:G3209 &rest #8=#:call-return-args-3207) "\302J \"\207" [#7# #8# apply] 3] fetch-state "--fetch-state-3232--" #[(&rest #9=#:G3236) "G\302 \303\"\203\210\304\202\305\306 \307#)\207" [#9# #:G3237 arity-match (0 exactly) #[(&rest #10=#:G3241) "G\304 \305\"\203\302J\306\234\303J\303J*D\202\307\310 \311#)\207" [#10# #:G3242 #:--cl-lambda-seq-as-sym3246-- #:--cl-state-- arity-match (1 exactly) 0 error #2# lambda] 4] error #2# lambda] 4] #[(#11=#:G3235 &rest #12=#:fetch-state-args-3233) "\302J \"\207" [#11# #12# apply] 3] set-state "--set-state-3250--" #[(&rest #13=#:G3254) "G\304 \305\"\203/\306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316 D\316\nD\317\257E*\2024\320\321 \312#)\207" [#13# #:G3255 #:--cl-lambda-seq-as-sym3259-- #:--cl-val-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3259--" "--val--" 0 lambda #3# apply #[(#14=#:G3272 #:G3273 &rest #15=#:G3263) "G\305 \306\"\203\302J\307\234\fJ\fJ*D\202\310\311 \312#)\207" [#15# #:G3264 #:--cl-lambda-seq-as-sym3268-- #:--cl-state-- #14# arity-match (1 exactly) 0 error #2# lambda] 4] quote --cl-rest-- error #2#] 8] #[(#16=#:G3253 &rest #17=#:set-state-args-3251) "\302J \"\207" [#16# #17# apply] 3] fetch-state-alist "--fetch-state-alist-3274--" #[(&rest #18=#:G3278) "G\304 \305\"\203/\306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316 D\316\nD\317\257E*\2024\320\321 \312#)\207" [#18# #:G3279 #:--cl-lambda-seq-as-sym3283-- #:--cl-key-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3283--" "--key--" 0 lambda #3# apply #[(#19=#:G3296 #:G3297 &rest #20=#:G3287) "G\305 \306\"\203\302J\307\234\310\303J\fJ\"\303J*D\202#\311\312 \313#)\207" [#20# #:G3288 #:--cl-lambda-seq-as-sym3292-- #:--cl-state-- #19# arity-match (1 exactly) 0 alist error #2# lambda] 4] quote --cl-rest-- error #2#] 8] #[(#21=#:G3277 &rest #22=#:fetch-state-alist-args-3275) "\302J \"\207" [#21# #22# apply] 3] set-state-alist "--set-state-alist-3298--" #[(&rest #23=#:G3302) "G\305 \306\"\203=\307\310!\211L\210\307\311!\211\nJ\312\234L\210\307\313!\211\nJ\314\234L\210\315\316\317\320\321\fD\321 D\321\nD\322\257E+\202B\323\324 \315#)\207" [#23# #:G3303 #:--cl-lambda-seq-as-sym3309-- #:--cl-key-- #:--cl-val-- arity-match (2 exactly) make-symbol "--lambda-seq-as-sym3309--" "--key--" 0 "--val--" 1 lambda #3# apply #[(#24=#:G3324 #25=#:G3325 #:G3326 &rest #26=#:G3315) "G\306 \307\"\203 \302J\310\234\fJ\311\303J J\fJ#*D\202%\312\313 \314#)\207" [#26# #:G3316 #:--cl-lambda-seq-as-sym3320-- #:--cl-state-- #24# #25# arity-match (1 exactly) 0 alist>> error #2# lambda] 5] quote --cl-rest-- error #2#] 9] #[(#27=#:G3301 &rest #28=#:set-state-alist-args-3299) "\302J \"\207" [#27# #28# apply] 3] #:defunc-val3234 #:--cl-set-state-3250-- #:defunc-val3252 #:--cl-fetch-state-alist-3274-- #:defunc-val3276 #:--cl-set-state-alist-3298-- #:defunc-val3300] 9)
#@171 Define a function of state using monad-state. IE, bind the result of
(DOMONAD MONAD-STATE MONAD-FORMS ...BODY) to the function NAME.
(fn NAME MONAD-FORMS &body BODY)
(defalias 'defstatefun '(macro . #[(name monad-forms &rest body) "\304\305!\306 C\307\310\311\n BBBEF)\207" [state name monad-forms body gensym "state" defun funcall domonad monad-state] 8 (#$ . 12589)]))
(defalias 'seq-bind #[(v f) "\302\303\304 \"\"\207" [f v apply append mapcar] 5])
(defalias 'seq-return #[(v) "C\207" [v] 1])
#@77 The list/sequence monad. Combine computations over multiple possibilities.
(defvar monad-seq (tbl! :m-zero nil :m-return #[(x) "C\207" [x] 1] :m-bind #[(v f) "\302\303\304 \"\"\207" [f v apply append mapcar] 5]) (#$ . 13101))
#@78 Like mapcat, but turns non-list elements into lists if they are encountered.
(defalias 'map-cat-or-suffix #[(f lst) "<\203 \202 C\306\211 :\2034 @\307\f\n!\211<\203& \202( C)! \244 A\211\202 \237+\207" [lst #1=#:--cl-var-- item #2=#:--cl-var-- f result nil reverse] 4 (#$ . 13336)])
#@210 The implicit list/sequence monad. Combine computations over
multiple possibilities. Bind handles promoting single results
to lists. If you want to include a list, you have to m-return
it explicitly. 
(defvar monad-seq^i (tbl! :m-zero nil :m-return #[(x) "C\207" [x] 1] :m-bind #[(v f) "\302 \"\207" [f v map-cat-or-suffix] 3]) (#$ . 13643))
#@359 Returns a SET-MONAD with PREDICATE semantics.
This is similar to the sequence
monad, but only admits unique results under PREDICATE.
(domonad (monad-set #'=)
[x '(1 2 3)
y '(1 2 3)]
(+ x y))
yields: (2 3 4 5 6)
(domonad monad-seq
[x '(1 2 3)
y '(1 2 3)]
(+ x y))
yields: (2 3 4 3 4 5 4 5 6)

(defalias 'monad-set #[(predicate) "\302\303!\211 L\210\304\305\306\307\310\311\312\313\314\315\316D\317FE&)\207" [#1=#:--cl-lpred-- predicate make-symbol "--lpred--" tbl! :m-zero nil :m-return #[(x) "C\207" [x] 1] :m-bind lambda (&rest --cl-rest--) apply #[(#2=#:G3327 v f) "\303\304\305\306 \"\"\nJ\"\207" [f v #2# unique apply append mapcar] 6] quote --cl-rest--] 13 (#$ . 14002)])
(defalias 'map-cat-or-suffix-set #[(f lst predicate) "\306\307\"\310\311!\211\205\311K\312\216\311\313M\210\310\314!\211\205 \314K\315\216\314\316M\210<\2032\2025C\317\211:\203w@\320!\211<\203]\321\314\"\202g\314!\205gC)!\244A\211\202?\237.\n\207" [predicate memo-table #1=#:--cl-letf-bound-- #2=#:--cl-letf-save-- #3=#:--cl-letf-bound-- #4=#:--cl-letf-save-- make-hash-table :test fboundp memo ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#1# #2# memo fmakunbound] 2)) #[(item) "\302\303 #\207" [item memo puthash t] 4] not-seen ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#3# #4# not-seen fmakunbound] 2)) #[(item) "\302 \"?\205\303\304\303 #\210\207" [item memo-table gethash t puthash] 5] nil reverse filter lst #5=#:--cl-var-- item #6=#:--cl-var-- f res] 6])
#@359 Returns a SET-MONAD with PREDICATE semantics.
This is similar to the sequence
monad, but only admits unique results under PREDICATE.
(domonad (monad-set #'=)
[x '(1 2 3)
y '(1 2 3)]
(+ x y))
yields: (2 3 4 5 6)
(domonad monad-seq
[x '(1 2 3)
y '(1 2 3)]
(+ x y))
yields: (2 3 4 3 4 5 4 5 6)

(defalias 'monad-set^i #[(predicate) "\302\303!\211 L\210\304\305\306\307\310\311\312\313\314\315\316D\317FE&)\207" [#1=#:--cl-lpred-- predicate make-symbol "--lpred--" tbl! :m-zero nil :m-return #[(x) "C\207" [x] 1] :m-bind lambda (&rest --cl-rest--) apply #[(#2=#:G3328 v f) "\303 \nJ#\207" [f v #2# map-cat-or-suffix-set] 4] quote --cl-rest--] 13 (#$ . 15613)])
#@52 Call the bind function in MONAD with args V and F.
(defalias 'm-m-bind #[(monad v f) "\303\304\" \n\"\207" [monad v f tbl :m-bind] 3 (#$ . 16347)])
#@43 Call the RETURN function in MONAD with V.
(defalias 'm-m-return #[(monad v) "\302\303\" !\207" [monad v tbl :m-return] 3 (#$ . 16502)])
#@39 Not documented
(fn MONAD &body BODY)
(defalias 'with-monad '(macro . #[(monad &rest body) "\302 BB\207" [monad body lexical-let-monad] 3 (#$ . 16645)]))
#@39 Not documented
(fn MONAD &body BODY)
(defalias 'with-monad-dyn '(macro . #[(monad &rest body) "\302 BB\207" [monad body let-monad] 3 (#$ . 16806)]))
(byte-code "\306\307\310!\211\311L\210\312\306\313\314\315\316\317 D\320FE\"\210\306\321\306!\210\n\210+\322\307\323!\211\324L\210\312\322\313\314\315\325\317 D\320FE\"\210\322\321\322!\210\f\210+\326\307\327!\211\330L\210\312\326\313\314\315\331\317 D\320FE\"\210\326\321\326!\210\210+\306\207" [currently-defining-defn #:--cl-halt-3329-- #:defunc-val3331 #:--cl-yield-3353-- #:defunc-val3355 #:--cl-bounce-3386-- halt make-symbol "--halt-3329--" #[(&rest #1=#:G3333) "G\304 \305\"\203/\306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316 D\316\nD\317\257E*\2024\320\321 \312#)\207" [#1# #:G3334 #:--cl-lambda-seq-as-sym3338-- #:--cl-x-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3338--" "--x--" 0 lambda #2=(&rest --cl-rest--) apply #[(#3=#:G3351 #:G3352 &rest #4=#:G3342) "G\305 \306\"\203\302J\307\234\fJ*\202\310\311 \312#)\207" [#4# #:G3343 #:--cl-lambda-seq-as-sym3347-- #:--cl-c-- #3# arity-match (1 exactly) 0 error #5="Unable to find an arity match for %d args in fn %s." lambda] 4] quote --cl-rest-- error #5#] 8] defalias lambda #2# apply #[(#6=#:G3332 &rest #7=#:halt-args-3330) "\302J \"\207" [#6# #7# apply] 3] quote --cl-rest-- byte-compile yield "--yield-3353--" #[(&rest #8=#:G3357) "G\304 \305\"\203/\306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316 D\316\nD\317\257E*\2024\320\321 \312#)\207" [#8# #:G3358 #:--cl-lambda-seq-as-sym3362-- #:--cl-x-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3362--" "--x--" 0 lambda #2# apply #[(#9=#:G3384 #10=#:G3385 &rest #11=#:G3366) "G\306 \307\"\2038\310\311!\211L\210\310\312!\211\nJ\313\234L\210\fJ\314\315\316\317\320 D\320\nD\320\fD\320 D\321\257E*D\202=\322\323 \314#)\207" [#11# #:G3367 #:--cl-lambda-seq-as-sym3371-- #:--cl-c-- #9# #10# arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3371--" "--c--" 0 lambda #2# apply #[(#12=#:G3380 #:G3381 #13=#:G3382 #:G3383 &rest #14=#:G3375) "G\305 \306\"\203 J\fJ!)\202\307\310 \311#)\207" [#14# #:G3376 #:--cl-lambda-seq-as-sym3378-- #12# #13# arity-match (0 exactly) error #5# lambda] 4] quote --cl-rest-- error #5#] 11] quote --cl-rest-- error #5#] 8] #[(#15=#:G3356 &rest #16=#:yield-args-3354) "\302J \"\207" [#15# #16# apply] 3] bounce "--bounce-3386--" #[(&rest #17=#:G3390) "G\304 \305\"\203/\306\307!\211L\210\306\310!\211\nJ\311\234L\210\312\313\314\315\316 D\316\nD\317\257E*\2024\320\321 \312#)\207" [#17# #:G3391 #:--cl-lambda-seq-as-sym3395-- #:--cl-x-- arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3395--" "--x--" 0 lambda #2# apply #[(#18=#:G3417 #19=#:G3418 &rest #20=#:G3399) "G\306 \307\"\2035\310\311!\211L\210\310\312!\211\nJ\313\234L\210\314\315\316\317\320 D\320\nD\320\fD\320 D\321\257E*\202:\322\323 \314#)\207" [#20# #:G3400 #:--cl-lambda-seq-as-sym3404-- #:--cl-c-- #18# #19# arity-match (1 exactly) make-symbol "--lambda-seq-as-sym3404--" "--c--" 0 lambda #2# apply #[(#21=#:G3413 #:G3414 #22=#:G3415 #:G3416 &rest #23=#:G3408) "G\305 \306\"\203 J\fJ!)\202\307\310 \311#)\207" [#23# #:G3409 #:--cl-lambda-seq-as-sym3411-- #21# #22# arity-match (0 exactly) error #5# lambda] 4] quote --cl-rest-- error #5#] 10] quote --cl-rest-- error #5#] 8] #[(#24=#:G3389 &rest #25=#:bounce-args-3387) "\302J \"\207" [#24# #25# apply] 3] #:defunc-val3388] 9)
(defalias 'm-chain2 #[(v1 v2) "\304\305!\304\306!\211\nL\210 L\210\307\310\311\312\313D\313 D\314\257E*\207" [#1=#:--cl-v2-- #2=#:--cl-v1-- v1 v2 make-symbol "--v1--" "--v2--" lambda (&rest --cl-rest--) apply #[(#3=#:G3419 #4=#:G3420 init) "\303\211 J\"\nJ\"\207" [init #3# #4# m-bind] 4] quote --cl-rest--] 8])
(defalias 'm-chain #[(&rest vs) "\305!\211@ A\306 :\203 @\307\f\n\" A\211\202 \n,\207" [vs rvs chain #1=#:--cl-var-- f reverse nil m-chain2] 5])
#@241 Create a dynamic scope in which MONAD is exposed
as CURRENT-MONAD, with M-ZERO and functions M-PLUS, M-BIND, M-RETURN and >>= (bind)
defined via let and flet forms. Useing this inside LEXICAL-LET-MONAD is undefined.
(fn MONAD &rest BODY)
(defalias 'let-monad '(macro . #[(monad &rest body) "\302\303D\304B\305\306\307 BBF\207" [monad body let* current-monad ((m-zero (tbl current-monad :m-zero))) (if (not (monad\? current-monad)) (error "Expected a monad in an mlet or similar form. \nA monad is a hash table with m-return and m-bind forms.")) flet ((m-bind (v f) (funcall (tbl current-monad :m-bind) v f)) (m-return (&rest v) (apply (tbl current-monad :m-return) v)) (>>= (v f) (funcall (tbl current-monad :m-bind) v f)) (m-plus (mv1 mv2) (funcall (tbl current-monad :m-plus) mv1 mv2)))] 6 (#$ . 20776)]))
#@193 Create a LEXICAL scope in which MONAD is exposed
as CURRENT-MONAD, with M-ZERO and functions M-PLUS, M-BIND, M-RETURN and >>= (bind)
defined via lexical-let and LABELS.
(fn MONAD &rest BODY)
(defalias 'lexical-let-monad '(macro . #[(monad &rest body) "\302\303D\304B\305\306\307 BBF\207" [monad body lexical-let* current-monad ((m-zero (tbl current-monad :m-zero))) (if (not (monad\? current-monad)) (error "Expected a monad in an mlet or similar form. \nA monad is a hash table with m-return and m-bind forms.")) labels ((m-bind (v f) (funcall (tbl current-monad :m-bind) v f)) (m-return (&rest v) (apply (tbl current-monad :m-return) v)) (>>= (v f) (funcall (tbl current-monad :m-bind) v f)) (m-plus (mv1 mv2) (funcall (tbl current-monad :m-plus) mv1 mv2)))] 6 (#$ . 21595)]))
#@41 Not documented
(fn BINDERS &rest BODY)
(defalias 'lexical-domonad-inner '(macro . #[(binders &rest body) "\306!\203\n\307 B\207C\211\310\234\311\312 \" \310\234 \313\234\314\315\316 !\317\f BBEE-\207" [binders body #1=#:lambda-seq-as-sym3424 #2=#:lambda-seq-as-sym3433 rest-binders sym empty\? progn 0 nthcdr-preserve-type 2 1 m-bind fn vector lexical-domonad-inner expr] 8 (#$ . 22383)]))
#@310 LEXICAL-DOMONAD - sequence binders (a clojure vector binding expression) through
{MONAD}, which is the current dynamically scoped monad, if not supplied.
Finally execute and return BODY. BODY and BINDERS have LEXICALLY scoped copies
of the monad and associated functions.
(fn {MONAD} BINDERS &body BODY)
(defalias 'lexical-domonad '(macro . #[({monad} binders &rest body) "\303!\203\304\305 \nBBBB\207\306\307\305\310 \nBBEE\207" [{monad} binders body vectorp lexical-domonad current-monad let-monad lexical-let-monad lexical-domonad-inner] 7 (#$ . 22792)]))
#@41 Not documented
(fn BINDERS &rest BODY)
(defalias 'domonad-inner '(macro . #[(binders &rest body) "\306!\203\n\307 B\207C\211\310\234\311\312 \" \310\234 \313\234\314 \315\316\f!\317 BBEE-\207" [binders body #1=#:lambda-seq-as-sym3437 #2=#:lambda-seq-as-sym3446 sym expr empty\? progn 0 nthcdr-preserve-type 2 1 m-bind fn vector domonad-inner] 8 (#$ . 23367)]))
#@380 DOMONAD - sequence binders (a clojure vector binding expression) through
{MONAD}, which is the current dynamically scoped monad, if not supplied.
Finally execute and return BODY. BODY and BINDERS have DYNAMICALLY scoped copies
of the monad and associated functions.
Use this form if you wish to define a function which is MONAD independent.
(fn {MONAD} BINDERS &body BODY)
(defalias 'domonad '(macro . #[({monad} binders &rest body) "\303!\203\304\305 \nBBBB\207\306\307 \nBBE\207" [{monad} binders body vectorp domonad current-monad let-monad domonad-inner] 5 (#$ . 23745)]))
#@41 Not documented
(fn BINDERS &rest BODY)
(defalias 'domonad-inner< '(macro . #[(binders &rest body) "\306!\203\f\307\310 BD\207C\211\311\234\312\313 \" \311\234 \314\234\315 \316\317\f!\320 BBEE-\207" [binders body #1=#:lambda-seq-as-sym3450 #2=#:lambda-seq-as-sym3459 sym expr empty\? m-return progn 0 nthcdr-preserve-type 2 1 m-bind fn vector domonad-inner<] 8 (#$ . 24339)]))
#@482 DOMONAD - sequence binders (a clojure vector binding expression) through
{MONAD}, which is the current dynamically scoped monad, if not supplied.
Finally execute and return BODY, wrapping the result with M-RETURN.
BODY and BINDERS have DYNAMICALLY scoped copies
of the monad and associated functions.
Use this form if you wish to define a function which is MONAD independent.
This form corresponds most directly to the Clojure DOMONAD form.
(fn {MONAD} BINDERS &body BODY)
(defalias 'domonad< '(macro . #[({monad} binders &rest body) "\303!\203\304\305 \nBBBB\207\306\307 \nBBE\207" [{monad} binders body vectorp domonad< current-monad let-monad domonad-inner<] 5 (#$ . 24733)]))
#@41 Not documented
(fn BINDERS &rest BODY)
(defalias 'lexical-domonad-inner< '(macro . #[(binders &rest body) "\306!\203\f\307\310 BD\207C\211\311\234\312\313 \" \311\234 \314\234\315 \316\317\f!\320 BBEE-\207" [binders body #1=#:lambda-seq-as-sym3463 #2=#:lambda-seq-as-sym3472 sym expr empty\? m-return progn 0 nthcdr-preserve-type 2 1 m-bind fn vector lexical-domonad-inner<] 8 (#$ . 25432)]))
#@382 LEXICAL-DOMONAD< - sequence binders (a clojure vector binding expression) through
{MONAD}, which is the current dynamically scoped monad, if not supplied.
Finally execute and return BODY, wrapping the result with M-RETURN.
BODY and BINDERS have LEXICALLY scoped copies
of the monad and associated functions.
This is the most heavy duty form.
(fn {MONAD} BINDERS &body BODY)
(defalias 'lexical-domonad< '(macro . #[({monad} binders &rest body) "\303!\203\304\305 \nBBBB\207\306\307\305\310 \nBBEE\207" [{monad} binders body vectorp lexical-domonad< current-monad let-monad lexical-let-monad lexical-domonad-inner<] 7 (#$ . 25842)]))
#@41 Not documented
(fn BINDERS &body BODY)
(defalias 'lexical-mlet-inner '(macro . #[(binders &rest body) "\306!\203\n\307 B\207@\211@\n\211A@)\310 \311 C\312A BBEE+\207" [binders body binder symbol x expr empty\? progn m-bind lex-lambda lexical-mlet-inner] 8 (#$ . 26492)]))
#@297 LEXICAL-MLET - Chain the operations in BINDERS, regular
lisp style let binding expressions, through the monad MONAD,
finally returning the result of BODY. Lexically bound copies
of the monad and monad functions are provided in the expression
forms of this macro.
(fn MONAD BINDERS &body BODY)
(defalias 'lexical-mlet '(macro . #[(monad binders &rest body) "\303\304\305\306 \nBBEE\207" [monad binders body let-monad lexical-let-monad current-monad lexical-mlet-inner] 7 (#$ . 26780)]))
#@41 Not documented
(fn BINDERS &rest BODY)
(defalias 'lexical-mlet-inner< '(macro . #[(binders &rest body) "\306!\203\f\307\310 BD\207@\211@\n\211A@)\311 \312 C\313A BBEE+\207" [binders body binder symbol x expr empty\? m-return progn m-bind lex-lambda lexical-mlet-inner<] 8 (#$ . 27276)]))
#@337 LEXICAL-MLET - Chain the operations in BINDERS, regular
lisp style let binding expressions, through the monad MONAD,
finally returning the result of BODY, wrapped in a final call
to M-RETURN.
Lexically bound copies
of the monad and monad functions are provided in the expression
forms of this macro.
(fn MONAD BINDERS &rest BODY)
(defalias 'lexical-mlet< '(macro . #[(monad binders &rest body) "\303\304DC\305\306\307\304\310 \nBBEEF\207" [monad binders body let current-monad (if (not (monad\? current-monad)) (error "Expected a monad in lexical-mlet< or similar form. A monad is a hash table with m-return and m-bind forms.")) let-monad lexical-let-monad lexical-mlet-inner<] 10 (#$ . 27580)]))
#@41 Not documented
(fn BINDERS &rest BODY)
(defalias 'mlet-inner '(macro . #[(binders &rest body) "\306!\203\n\307 B\207@\211@\n\211A@)\310 \311 C\312A BBEE+\207" [binders body binder symbol x expr empty\? progn m-bind lex-lambda mlet-inner] 8 (#$ . 28292)]))
#@262 MLET - Monadic let. Sequence the bindings represented in BINDINGS,
which resemble regular lisp let-like binding forms, through the monad
MONAD. Finally execute and return body.
This is the most emacs-lisp flavored monad form.
(fn MONAD BINDERS &rest BODY)
(defalias 'mlet '(macro . #[(monad binders &rest body) "\303\304 \nBBE\207" [monad binders body let-monad mlet-inner] 5 (#$ . 28564)]))
#@41 Not documented
(fn BINDERS &rest BODY)
(defalias 'mlet-inner< '(macro . #[(binders &rest body) "\306!\203\f\307\310 BD\207@\211@\n\211A@)\311 \312 C\313A BBEE+\207" [binders body binder symbol x expr empty\? m-return progn m-bind lex-lambda mlet-inner<] 8 (#$ . 28968)]))
#@241 MLET - Monadic let. Sequence the bindings represented in BINDINGS,
which resemble regular lisp let-like binding forms, through the monad
MONAD. Finally execute and return body, wrapped in a final M-RETURN.
(fn MONAD BINDERS &rest BODY)
(defalias 'mlet< '(macro . #[(monad binders &rest body) "\304!\204\n\305\306!\210\307 \310\n BBE\207" [current-monad monad binders body monad\? error "Expected a monad in mlet or similar form. A monad is a hash table with m-return and m-bind forms." let-monad mlet-inner<] 5 (#$ . 29256)]))
(defalias 'tagged-value\? #[(tag val) "<\205 @ =\207" [val tag] 2])
(defalias 'tagged-monad #[(tag) "\302\303!\211 L\210\304\305\306\307\310\311\312D\313FE\314\306\307\310\315\312D\313FE$)\207" [#1=#:--cl-tag-- tag make-symbol "--tag--" tbl! :m-bind lambda (&rest --cl-rest--) apply #[(#2=#:G3473 v f) " \306\fJ\303J\"\204\307\310\fJ\"\210\302J\303J\211A@)!*\207" [v f #3=#:--cl-f-- #4=#:--cl-v-- #2# x tagged-value\? error "Tagged monad error, expected tagged value of tag %s"] 4] quote --cl-rest-- :m-return #[(#5=#:G3474 v) "J D\207" [#5# v] 2]] 11])
(byte-code "\305\306\307!\211\310L\210\311\305\312\313\314\315\316 D\317FE\"\210\305\320\305!\210\n\210+\321\306\322!\211\323L\210\311\321\312\313\314\324\316 D\317FE\"\210\321\320\321!\210\f\210+\305\207" [currently-defining-defn #:--cl-maybe+-3475-- #:defunc-val3477 #:--cl-maybe/-3492-- #:defunc-val3494 maybe+ make-symbol "--maybe+-3475--" #[(&rest #1=#:G3479) "G\305 \306\"\203!\302J\307\234\302J\310\234\311\303J\304J\\!+\202&\312\313 \314#)\207" [#1# #:G3480 #:--cl-lambda-seq-as-sym3486-- #:--cl-x-- #:--cl-y-- arity-match (2 exactly) 0 1 Just error #2="Unable to find an arity match for %d args in fn %s." lambda] 4] defalias lambda (&rest --cl-rest--) apply #[(#3=#:G3478 &rest #4=#:maybe+-args-3476) "\302J \"\207" [#3# #4# apply] 3] quote --cl-rest-- byte-compile maybe/ "--maybe/-3492--" #[(&rest #5=#:G3496) "G\305 \306\"\203-\302J\307\234\302J\310\234\304J\307U\203\"\311 \202)\312\303J\304J\245!+\2022\313\314 \315#)\207" [#5# #:G3497 #:--cl-lambda-seq-as-sym3503-- #:--cl-x-- #:--cl-y-- arity-match (2 exactly) 0 1 None Just error #2# lambda] 4] #[(#6=#:G3495 &rest #7=#:maybe/-args-3493) "\302J \"\207" [#6# #7# apply] 3]] 9)
#@95 Combine the monadic values in VLST into a monadic value using
the rules of the current monad.
(defalias 'm-seq #[(vlst) "\301\302\303!\304\305\306!$\207" [vlst reduce #[(output v) "\301\302\"\207" [v m-bind #[(x) "\301\302\"\207" [output m-bind #[(y) "\302 B!\207" [x y m-return] 3]] 3]] 3] reverse :initial-value m-return nil] 6 (#$ . 31533)])
#@99 Map F across the values in XS, combining the results
monadically, according to the current monad.
(defalias 'm-mapcar #[(f xs) "\302\303 \"!\207" [f xs m-seq mapcar] 4 (#$ . 31888)])
#@48 Quickly checks whether L has only one element.
(defalias 'single-element-list\? #[(l) "A?\207" [l] 1 (#$ . 32078)])
#@52 Checks a list to see if it looks like (VAR <- VAL)
(defalias 'monadic-do-binder\? #[(l) "<\205\211A@)\302=\205@9\207" [l x <-] 3 (#$ . 32201)])
#@39 Help expand alternative monad syntax.
(defalias 'monadic-do-helper '(macro . #[(&rest bodies) "\305!\203&@\306 !\203#\307\310 \211AA)@\311 @C @EF\202$ )\207@A\306 !\203G\307\312 \211AA)@\311 @C\313 BEF\202W\314\315!\307\316 \317\fC\313 BEF)*\207" [bodies b x rest id single-element-list\? monadic-do-binder\? funcall (gethash :m-bind current-monad) lex-lambda (gethash :m-bind current-monad) monadic-do-helper gensym "id" (gethash :m-bind current-monad) lambda] 8 (#$ . 32359)]))
#@186 Alternative monadic binding syntax. Each BODY must be a
binding form, (symbol <- expr), which monadically binds
symbol monadically, or an expression which results in an
monadic value.
(defalias 'monadic-do '(macro . #[(monad &rest bodies) "\302\303 BE\207" [monad bodies with-monad monadic-do-helper] 4 (#$ . 32861)]))
#@51 Generate the temporary variable names for a lift.
(defalias 'gen-m-lift-binding #[(arg-names) "\304\305\211 :\203 @\306\n\211D! \244 A\211\202 \237+\307\"\207" [arg-names #1=#:--cl-var-- a #2=#:--cl-var-- coerce nil reverse vector] 5 (#$ . 33188)])
#@54 Macro - LIFT F (with N args) into the current monad.
(defalias 'm-lift '(macro . #[(n f) "\306\307\310\311\"\312!\"\313\314!\315\n DC\316 \317\320 \321\211\f:\2035\f@\211\211DB\fA\211\202\237+\322\n BBFEE*\207" [n arg-names f-to-lift f #1=#:--cl-var-- nm mapcar pal gensymf "lift-arg%d-" range gensym "f-to-lift" lexical-let lambda mlet< current-monad nil funcall #2=#:--cl-var--] 10 (#$ . 33454)]))
#@54 Macro - LIFT F (with N args) into the current monad.
(defalias 'm-lift-into '(macro . #[(n f monad) "\304\305!\306\307D\310 \311\312\n EEEE)\207" [lifted-args monad n f gensym "lifted-args" lambda &rest let-monad apply m-lift] 8 (#$ . 33878)]))
(defalias 'm-lift-into1 #[(f monad) "\300\207" [#[(&rest #1=#:lifted-args3509) "\306 \307\"\310 !\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K \320\216\317\321M\210\313\322!\211!\205?\322K\"\323\216\322\324M\210\313\325!\211#\205R\325K$\326\216\325\327M\210\330\331\332!\211%&L\210\333\334\330\335\336%D\337FE)'\".\207" [monad current-monad m-zero #2=#:--cl-letf-bound-- #3=#:--cl-letf-save-- #4=#:--cl-letf-bound-- tbl :m-zero monad\? error #5="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" [#2# #3# 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" [#4# #6=#:--cl-letf-save-- m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#7=#:--cl-letf-bound-- #8=#:--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" [#9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] apply make-symbol "--f-to-lift3513--" lambda #11=(&rest --cl-rest--) #[(#12=#:G3515 #13=#:lift-arg0-3512) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #14=#:--cl-letf-bound-- #15=#:--cl-letf-save-- #16=#:--cl-letf-bound-- #17=#:--cl-letf-save-- tbl :m-zero monad\? error #5# fboundp m-bind ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#14# #15# 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" [#16# #17# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#18=#:--cl-letf-bound-- #19=#:--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" [#20=#:--cl-letf-bound-- #21=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #11# apply #[(#22=#:G3514 #13#) "\303\nJ\301J!!)\207" [#13# #23=#:--cl-lift-arg0-3512-- #22# m-return] 3] quote --cl-rest-- #18# #19# #20# #21# #13# #12#] 9] quote --cl-rest-- #6# #7# #8# #9# #10# #24=#:--cl-f-to-lift3513-- f #1#] 8]] 1])
(defalias 'm-lift-into2 #[(f monad) "\300\207" [#[(&rest #1=#:lifted-args3516) "\306 \307\"\310 !\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K \320\216\317\321M\210\313\322!\211!\205?\322K\"\323\216\322\324M\210\313\325!\211#\205R\325K$\326\216\325\327M\210\330\331\332!\211%&L\210\333\334\330\335\336%D\337FE)'\".\207" [monad current-monad m-zero #2=#:--cl-letf-bound-- #3=#:--cl-letf-save-- #4=#:--cl-letf-bound-- tbl :m-zero monad\? error #5="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" [#2# #3# 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" [#4# #6=#:--cl-letf-save-- m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#7=#:--cl-letf-bound-- #8=#:--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" [#9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] apply make-symbol "--f-to-lift3521--" lambda #11=(&rest --cl-rest--) #[(#12=#:G3525 #13=#:lift-arg0-3519 #14=#:lift-arg1-3520) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #15=#:--cl-letf-bound-- #16=#:--cl-letf-save-- #17=#:--cl-letf-bound-- #18=#:--cl-letf-save-- tbl :m-zero monad\? error #5# fboundp m-bind ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#15# #16# 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" [#17# #18# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#19=#:--cl-letf-bound-- #20=#:--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" [#21=#:--cl-letf-bound-- #22=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #11# apply #[(#23=#:G3524 #13#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#24=#:--cl-lift-arg0-3519-- #13# #14# #23# make-symbol "--lift-arg0-3519--" m-bind lambda #11# apply #[(#25=#:G3522 #26=#:G3523 #14#) "\304\nJ J\301J\"!)\207" [#14# #27=#:--cl-lift-arg1-3520-- #26# #25# m-return] 4] quote --cl-rest--] 10] quote --cl-rest-- #19# #20# #21# #22# #13# #12#] 9] quote --cl-rest-- #6# #7# #8# #9# #10# #28=#:--cl-f-to-lift3521-- f #1#] 8]] 1])
(defalias 'm-lift-into3 #[(f monad) "\300\207" [#[(&rest #1=#:lifted-args3526) "\306 \307\"\310 !\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K \320\216\317\321M\210\313\322!\211!\205?\322K\"\323\216\322\324M\210\313\325!\211#\205R\325K$\326\216\325\327M\210\330\331\332!\211%&L\210\333\334\330\335\336%D\337FE)'\".\207" [monad current-monad m-zero #2=#:--cl-letf-bound-- #3=#:--cl-letf-save-- #4=#:--cl-letf-bound-- tbl :m-zero monad\? error #5="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" [#2# #3# 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" [#4# #6=#:--cl-letf-save-- m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#7=#:--cl-letf-bound-- #8=#:--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" [#9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] apply make-symbol "--f-to-lift3532--" lambda #11=(&rest --cl-rest--) #[(#12=#:G3539 #13=#:lift-arg0-3529 #14=#:lift-arg1-3530 #15=#:lift-arg2-3531) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #16=#:--cl-letf-bound-- #17=#:--cl-letf-save-- #18=#:--cl-letf-bound-- #19=#:--cl-letf-save-- tbl :m-zero monad\? error #5# fboundp m-bind ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#16# #17# 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" [#18# #19# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#20=#:--cl-letf-bound-- #21=#:--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" [#22=#:--cl-letf-bound-- #23=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #11# apply #[(#24=#:G3538 #13#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#25=#:--cl-lift-arg0-3529-- #13# #14# #24# make-symbol "--lift-arg0-3529--" m-bind lambda #11# apply #[(#26=#:G3536 #27=#:G3537 #14#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#28=#:--cl-lift-arg1-3530-- #14# #15# #26# #27# make-symbol "--lift-arg1-3530--" m-bind lambda #11# apply #[(#29=#:G3533 #30=#:G3534 #31=#:G3535 #15#) "\305\nJ J\fJ\301J#!)\207" [#15# #32=#:--cl-lift-arg2-3531-- #31# #30# #29# m-return] 5] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #20# #21# #22# #23# #13# #12#] 9] quote --cl-rest-- #6# #7# #8# #9# #10# #33=#:--cl-f-to-lift3532-- f #1#] 8]] 1])
(defalias 'm-lift-into4 #[(f monad) "\300\207" [#[(&rest #1=#:lifted-args3540) "\306 \307\"\310 !\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K \320\216\317\321M\210\313\322!\211!\205?\322K\"\323\216\322\324M\210\313\325!\211#\205R\325K$\326\216\325\327M\210\330\331\332!\211%&L\210\333\334\330\335\336%D\337FE)'\".\207" [monad current-monad m-zero #2=#:--cl-letf-bound-- #3=#:--cl-letf-save-- #4=#:--cl-letf-bound-- tbl :m-zero monad\? error #5="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" [#2# #3# 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" [#4# #6=#:--cl-letf-save-- m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#7=#:--cl-letf-bound-- #8=#:--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" [#9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] apply make-symbol "--f-to-lift3547--" lambda #11=(&rest --cl-rest--) #[(#12=#:G3558 #13=#:lift-arg0-3543 #14=#:lift-arg1-3544 #15=#:lift-arg2-3545 #16=#:lift-arg3-3546) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #17=#:--cl-letf-bound-- #18=#:--cl-letf-save-- #19=#:--cl-letf-bound-- #20=#:--cl-letf-save-- tbl :m-zero monad\? error #5# fboundp m-bind ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#17# #18# 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" [#19# #20# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#21=#:--cl-letf-bound-- #22=#:--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" [#23=#:--cl-letf-bound-- #24=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #11# apply #[(#25=#:G3557 #13#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#26=#:--cl-lift-arg0-3543-- #13# #14# #25# make-symbol "--lift-arg0-3543--" m-bind lambda #11# apply #[(#27=#:G3555 #28=#:G3556 #14#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#29=#:--cl-lift-arg1-3544-- #14# #15# #27# #28# make-symbol "--lift-arg1-3544--" m-bind lambda #11# apply #[(#30=#:G3552 #31=#:G3553 #32=#:G3554 #15#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\316\257E\")\207" [#33=#:--cl-lift-arg2-3545-- #15# #16# #30# #31# #32# make-symbol "--lift-arg2-3545--" m-bind lambda #11# apply #[(#34=#:G3548 #35=#:G3549 #36=#:G3550 #37=#:G3551 #16#) "\306\nJ J\fJ J\301J$!)\207" [#16# #38=#:--cl-lift-arg3-3546-- #37# #36# #35# #34# m-return] 6] quote --cl-rest--] 12] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #21# #22# #23# #24# #13# #12#] 9] quote --cl-rest-- #6# #7# #8# #9# #10# #39=#:--cl-f-to-lift3547-- f #1#] 8]] 1])
(defalias 'm-lift-into5 #[(f monad) "\300\207" [#[(&rest #1=#:lifted-args3559) "\306 \307\"\310 !\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K \320\216\317\321M\210\313\322!\211!\205?\322K\"\323\216\322\324M\210\313\325!\211#\205R\325K$\326\216\325\327M\210\330\331\332!\211%&L\210\333\334\330\335\336%D\337FE)'\".\207" [monad current-monad m-zero #2=#:--cl-letf-bound-- #3=#:--cl-letf-save-- #4=#:--cl-letf-bound-- tbl :m-zero monad\? error #5="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" [#2# #3# 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" [#4# #6=#:--cl-letf-save-- m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#7=#:--cl-letf-bound-- #8=#:--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" [#9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] apply make-symbol "--f-to-lift3567--" lambda #11=(&rest --cl-rest--) #[(#12=#:G3583 #13=#:lift-arg0-3562 #14=#:lift-arg1-3563 #15=#:lift-arg2-3564 #16=#:lift-arg3-3565 #17=#:lift-arg4-3566) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #18=#:--cl-letf-bound-- #19=#:--cl-letf-save-- #20=#:--cl-letf-bound-- #21=#:--cl-letf-save-- tbl :m-zero monad\? error #5# fboundp m-bind ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#18# #19# 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" [#20# #21# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#22=#:--cl-letf-bound-- #23=#:--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" [#24=#:--cl-letf-bound-- #25=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #11# apply #[(#26=#:G3582 #13#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#27=#:--cl-lift-arg0-3562-- #13# #14# #26# make-symbol "--lift-arg0-3562--" m-bind lambda #11# apply #[(#28=#:G3580 #29=#:G3581 #14#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#30=#:--cl-lift-arg1-3563-- #14# #15# #28# #29# make-symbol "--lift-arg1-3563--" m-bind lambda #11# apply #[(#31=#:G3577 #32=#:G3578 #33=#:G3579 #15#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\316\257E\")\207" [#34=#:--cl-lift-arg2-3564-- #15# #16# #31# #32# #33# make-symbol "--lift-arg2-3564--" m-bind lambda #11# apply #[(#35=#:G3573 #36=#:G3574 #37=#:G3575 #38=#:G3576 #16#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\315D\316\257E\")\207" [#39=#:--cl-lift-arg3-3565-- #16# #17# #35# #36# #37# make-symbol "--lift-arg3-3565--" m-bind lambda #11# apply #[(#40=#:G3568 #41=#:G3569 #42=#:G3570 #43=#:G3571 #44=#:G3572 #17#) "\306\nJ J\fJ JJ\301J%!)\207" [#17# #45=#:--cl-lift-arg4-3566-- #44# #43# #42# #41# m-return #40#] 7] quote --cl-rest-- #38#] 13] quote --cl-rest--] 12] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #22# #23# #24# #25# #13# #12#] 9] quote --cl-rest-- #6# #7# #8# #9# #10# #46=#:--cl-f-to-lift3567-- f #1#] 8]] 1])
(defalias 'm-lift-into6 #[(f monad) "\300\207" [#[(&rest #1=#:lifted-args3584) "\306 \307\"\310 !\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K \320\216\317\321M\210\313\322!\211!\205?\322K\"\323\216\322\324M\210\313\325!\211#\205R\325K$\326\216\325\327M\210\330\331\332!\211%&L\210\333\334\330\335\336%D\337FE)'\".\207" [monad current-monad m-zero #2=#:--cl-letf-bound-- #3=#:--cl-letf-save-- #4=#:--cl-letf-bound-- tbl :m-zero monad\? error #5="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" [#2# #3# 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" [#4# #6=#:--cl-letf-save-- m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#7=#:--cl-letf-bound-- #8=#:--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" [#9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] apply make-symbol "--f-to-lift3593--" lambda #11=(&rest --cl-rest--) #[(#12=#:G3615 #13=#:lift-arg0-3587 #14=#:lift-arg1-3588 #15=#:lift-arg2-3589 #16=#:lift-arg3-3590 #17=#:lift-arg4-3591 #18=#:lift-arg5-3592) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #19=#:--cl-letf-bound-- #20=#:--cl-letf-save-- #21=#:--cl-letf-bound-- #22=#:--cl-letf-save-- tbl :m-zero monad\? error #5# fboundp m-bind ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#19# #20# 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" [#21# #22# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#23=#:--cl-letf-bound-- #24=#:--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" [#25=#:--cl-letf-bound-- #26=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #11# apply #[(#27=#:G3614 #13#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#28=#:--cl-lift-arg0-3587-- #13# #14# #27# make-symbol "--lift-arg0-3587--" m-bind lambda #11# apply #[(#29=#:G3612 #30=#:G3613 #14#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#31=#:--cl-lift-arg1-3588-- #14# #15# #29# #30# make-symbol "--lift-arg1-3588--" m-bind lambda #11# apply #[(#32=#:G3609 #33=#:G3610 #34=#:G3611 #15#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\316\257E\")\207" [#35=#:--cl-lift-arg2-3589-- #15# #16# #32# #33# #34# make-symbol "--lift-arg2-3589--" m-bind lambda #11# apply #[(#36=#:G3605 #37=#:G3606 #38=#:G3607 #39=#:G3608 #16#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\315D\316\257E\")\207" [#40=#:--cl-lift-arg3-3590-- #16# #17# #36# #37# #38# make-symbol "--lift-arg3-3590--" m-bind lambda #11# apply #[(#41=#:G3600 #42=#:G3601 #43=#:G3602 #44=#:G3603 #45=#:G3604 #17#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\315D\315D\316\257 E\")\207" [#46=#:--cl-lift-arg4-3591-- #17# #18# #41# #42# #43# make-symbol "--lift-arg4-3591--" m-bind lambda #11# apply #[(#47=#:G3594 #48=#:G3595 #49=#:G3596 #50=#:G3597 #51=#:G3598 #52=#:G3599 #18#) "\306\nJ J\fJ JJJ\301J&!)\207" [#18# #53=#:--cl-lift-arg5-3592-- #52# #51# #50# #49# m-return #48# #47#] 8] quote --cl-rest-- #44# #45#] 14] quote --cl-rest-- #39#] 13] quote --cl-rest--] 12] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #23# #24# #25# #26# #13# #12#] 9] quote --cl-rest-- #6# #7# #8# #9# #10# #54=#:--cl-f-to-lift3593-- f #1#] 8]] 1])
(defalias 'm-lift1 #[(f) "\302\303!\211 L\210\304\305\306\307\310D\311FE)\207" [#1=#:--cl-f-to-lift3619-- f make-symbol "--f-to-lift3619--" lambda #2=(&rest --cl-rest--) apply #[(#3=#:G3621 #4=#:lift-arg0-3618) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #5=#:--cl-letf-bound-- #6=#:--cl-letf-save-- #7=#:--cl-letf-bound-- #8=#:--cl-letf-save-- 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" [#5# #6# 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" [#7# #8# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#9=#:--cl-letf-bound-- #10=#:--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" [#11=#:--cl-letf-bound-- #12=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #2# apply #[(#13=#:G3620 #4#) "\303\nJ\301J!!)\207" [#4# #14=#:--cl-lift-arg0-3618-- #13# m-return] 3] quote --cl-rest-- #9# #10# #11# #12# #4# #3#] 9] quote --cl-rest--] 7])
(defalias 'm-lift2 #[(f) "\302\303!\211 L\210\304\305\306\307\310D\311FE)\207" [#1=#:--cl-f-to-lift3626-- f make-symbol "--f-to-lift3626--" lambda #2=(&rest --cl-rest--) apply #[(#3=#:G3630 #4=#:lift-arg0-3624 #5=#:lift-arg1-3625) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #6=#:--cl-letf-bound-- #7=#:--cl-letf-save-- #8=#:--cl-letf-bound-- #9=#:--cl-letf-save-- 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" [#6# #7# 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" [#8# #9# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#10=#:--cl-letf-bound-- #11=#:--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" [#12=#:--cl-letf-bound-- #13=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #2# apply #[(#14=#:G3629 #4#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#15=#:--cl-lift-arg0-3624-- #4# #5# #14# make-symbol "--lift-arg0-3624--" m-bind lambda #2# apply #[(#16=#:G3627 #17=#:G3628 #5#) "\304\nJ J\301J\"!)\207" [#5# #18=#:--cl-lift-arg1-3625-- #17# #16# m-return] 4] quote --cl-rest--] 10] quote --cl-rest-- #10# #11# #12# #13# #4# #3#] 9] quote --cl-rest--] 7])
(defalias 'm-lift3 #[(f) "\302\303!\211 L\210\304\305\306\307\310D\311FE)\207" [#1=#:--cl-f-to-lift3636-- f make-symbol "--f-to-lift3636--" lambda #2=(&rest --cl-rest--) apply #[(#3=#:G3643 #4=#:lift-arg0-3633 #5=#:lift-arg1-3634 #6=#:lift-arg2-3635) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #7=#:--cl-letf-bound-- #8=#:--cl-letf-save-- #9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- 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" [#7# #8# 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" [#9# #10# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#11=#:--cl-letf-bound-- #12=#:--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" [#13=#:--cl-letf-bound-- #14=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #2# apply #[(#15=#:G3642 #4#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#16=#:--cl-lift-arg0-3633-- #4# #5# #15# make-symbol "--lift-arg0-3633--" m-bind lambda #2# apply #[(#17=#:G3640 #18=#:G3641 #5#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#19=#:--cl-lift-arg1-3634-- #5# #6# #17# #18# make-symbol "--lift-arg1-3634--" m-bind lambda #2# apply #[(#20=#:G3637 #21=#:G3638 #22=#:G3639 #6#) "\305\nJ J\fJ\301J#!)\207" [#6# #23=#:--cl-lift-arg2-3635-- #22# #21# #20# m-return] 5] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #11# #12# #13# #14# #4# #3#] 9] quote --cl-rest--] 7])
(defalias 'm-lift4 #[(f) "\302\303!\211 L\210\304\305\306\307\310D\311FE)\207" [#1=#:--cl-f-to-lift3650-- f make-symbol "--f-to-lift3650--" lambda #2=(&rest --cl-rest--) apply #[(#3=#:G3661 #4=#:lift-arg0-3646 #5=#:lift-arg1-3647 #6=#:lift-arg2-3648 #7=#:lift-arg3-3649) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #8=#:--cl-letf-bound-- #9=#:--cl-letf-save-- #10=#:--cl-letf-bound-- #11=#:--cl-letf-save-- 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" [#8# #9# 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" [#10# #11# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#12=#:--cl-letf-bound-- #13=#:--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" [#14=#:--cl-letf-bound-- #15=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #2# apply #[(#16=#:G3660 #4#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#17=#:--cl-lift-arg0-3646-- #4# #5# #16# make-symbol "--lift-arg0-3646--" m-bind lambda #2# apply #[(#18=#:G3658 #19=#:G3659 #5#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#20=#:--cl-lift-arg1-3647-- #5# #6# #18# #19# make-symbol "--lift-arg1-3647--" m-bind lambda #2# apply #[(#21=#:G3655 #22=#:G3656 #23=#:G3657 #6#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\316\257E\")\207" [#24=#:--cl-lift-arg2-3648-- #6# #7# #21# #22# #23# make-symbol "--lift-arg2-3648--" m-bind lambda #2# apply #[(#25=#:G3651 #26=#:G3652 #27=#:G3653 #28=#:G3654 #7#) "\306\nJ J\fJ J\301J$!)\207" [#7# #29=#:--cl-lift-arg3-3649-- #28# #27# #26# #25# m-return] 6] quote --cl-rest--] 12] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #12# #13# #14# #15# #4# #3#] 9] quote --cl-rest--] 7])
(defalias 'm-lift5 #[(f) "\302\303!\211 L\210\304\305\306\307\310D\311FE)\207" [#1=#:--cl-f-to-lift3669-- f make-symbol "--f-to-lift3669--" lambda #2=(&rest --cl-rest--) apply #[(#3=#:G3685 #4=#:lift-arg0-3664 #5=#:lift-arg1-3665 #6=#:lift-arg2-3666 #7=#:lift-arg3-3667 #8=#:lift-arg4-3668) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #9=#:--cl-letf-bound-- #10=#:--cl-letf-save-- #11=#:--cl-letf-bound-- #12=#:--cl-letf-save-- 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" [#9# #10# 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" [#11# #12# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#13=#:--cl-letf-bound-- #14=#:--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" [#15=#:--cl-letf-bound-- #16=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #2# apply #[(#17=#:G3684 #4#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#18=#:--cl-lift-arg0-3664-- #4# #5# #17# make-symbol "--lift-arg0-3664--" m-bind lambda #2# apply #[(#19=#:G3682 #20=#:G3683 #5#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#21=#:--cl-lift-arg1-3665-- #5# #6# #19# #20# make-symbol "--lift-arg1-3665--" m-bind lambda #2# apply #[(#22=#:G3679 #23=#:G3680 #24=#:G3681 #6#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\316\257E\")\207" [#25=#:--cl-lift-arg2-3666-- #6# #7# #22# #23# #24# make-symbol "--lift-arg2-3666--" m-bind lambda #2# apply #[(#26=#:G3675 #27=#:G3676 #28=#:G3677 #29=#:G3678 #7#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\315D\316\257E\")\207" [#30=#:--cl-lift-arg3-3667-- #7# #8# #26# #27# #28# make-symbol "--lift-arg3-3667--" m-bind lambda #2# apply #[(#31=#:G3670 #32=#:G3671 #33=#:G3672 #34=#:G3673 #35=#:G3674 #8#) "\306\nJ J\fJ JJ\301J%!)\207" [#8# #36=#:--cl-lift-arg4-3668-- #35# #34# #33# #32# m-return #31#] 7] quote --cl-rest-- #29#] 13] quote --cl-rest--] 12] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #13# #14# #15# #16# #4# #3#] 9] quote --cl-rest--] 7])
(defalias 'm-lift6 #[(f) "\302\303!\211 L\210\304\305\306\307\310D\311FE)\207" [#1=#:--cl-f-to-lift3694-- f make-symbol "--f-to-lift3694--" lambda #2=(&rest --cl-rest--) apply #[(#3=#:G3716 #4=#:lift-arg0-3688 #5=#:lift-arg1-3689 #6=#:lift-arg2-3690 #7=#:lift-arg3-3691 #8=#:lift-arg4-3692 #9=#:lift-arg5-3693) "\306\307\"\310!\204\311\312!\210\313\314!\211\205\314K\315\216\314\316M\210\313\317!\211\205,\317K\320\216\317\321M\210\313\322!\211\205>\322K\323\216\322\324M\210\313\325!\211 \205Q\325K!\326\216\325\327M\210\314\"\330\331\332\333\334#D\335FE\".\207" [current-monad m-zero #10=#:--cl-letf-bound-- #11=#:--cl-letf-save-- #12=#:--cl-letf-bound-- #13=#:--cl-letf-save-- 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" [#10# #11# 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" [#12# #13# m-return fmakunbound] 2)) #[(&rest v) "\302\303\304\" \"\207" [current-monad v apply tbl :m-return] 4 "Not documented\n\n(fn &rest V)"] >>= ((byte-code "\203 \302 M\210\202\303\302!\210\302\207" [#14=#:--cl-letf-bound-- #15=#:--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" [#16=#:--cl-letf-bound-- #17=#:--cl-letf-save-- m-plus fmakunbound] 2)) #[(mv1 mv2) "\303\304\" \n\"\207" [current-monad mv1 mv2 tbl :m-plus] 3] lambda #2# apply #[(#18=#:G3715 #4#) "\304\305!\211 L\210\306\n\307\310\311\312\313D\313 D\314\257E\")\207" [#19=#:--cl-lift-arg0-3688-- #4# #5# #18# make-symbol "--lift-arg0-3688--" m-bind lambda #2# apply #[(#20=#:G3713 #21=#:G3714 #5#) "\305\306!\211 L\210\307\n\310\311\312\313\314D\314 D\314\fD\315\257E\")\207" [#22=#:--cl-lift-arg1-3689-- #5# #6# #20# #21# make-symbol "--lift-arg1-3689--" m-bind lambda #2# apply #[(#23=#:G3710 #24=#:G3711 #25=#:G3712 #6#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\316\257E\")\207" [#26=#:--cl-lift-arg2-3690-- #6# #7# #23# #24# #25# make-symbol "--lift-arg2-3690--" m-bind lambda #2# apply #[(#27=#:G3706 #28=#:G3707 #29=#:G3708 #30=#:G3709 #7#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\315D\316\257E\")\207" [#31=#:--cl-lift-arg3-3691-- #7# #8# #27# #28# #29# make-symbol "--lift-arg3-3691--" m-bind lambda #2# apply #[(#32=#:G3701 #33=#:G3702 #34=#:G3703 #35=#:G3704 #36=#:G3705 #8#) "\306\307!\211 L\210\310\n\311\312\313\314\315D\315 D\315\fD\315 D\315D\315D\316\257 E\")\207" [#37=#:--cl-lift-arg4-3692-- #8# #9# #32# #33# #34# make-symbol "--lift-arg4-3692--" m-bind lambda #2# apply #[(#38=#:G3695 #39=#:G3696 #40=#:G3697 #41=#:G3698 #42=#:G3699 #43=#:G3700 #9#) "\306\nJ J\fJ JJJ\301J&!)\207" [#9# #44=#:--cl-lift-arg5-3693-- #43# #42# #41# #40# m-return #39# #38#] 8] quote --cl-rest-- #35# #36#] 14] quote --cl-rest-- #30#] 13] quote --cl-rest--] 12] quote --cl-rest--] 11] quote --cl-rest--] 10] quote --cl-rest-- #14# #15# #16# #17# #4# #3#] 9] quote --cl-rest--] 7])
(provide 'monads)