From 69be73e4a3ddb3a023f0aa83c869b1a33af88e54 Mon Sep 17 00:00:00 2001 From: "Duncan M. McGreggor" Date: Tue, 19 May 2015 23:30:19 -0500 Subject: [PATCH 1/5] Various formatting tweaks. --- src/calrissian-identity-monad.lfe | 4 +++- src/calrissian-maybe-monad.lfe | 7 +++++-- src/calrissian-monad.lfe | 14 ++++++++------ src/calrissian-util.lfe | 23 ++++++++++++----------- 4 files changed, 28 insertions(+), 20 deletions(-) diff --git a/src/calrissian-identity-monad.lfe b/src/calrissian-identity-monad.lfe index f090464..4be2a99 100644 --- a/src/calrissian-identity-monad.lfe +++ b/src/calrissian-identity-monad.lfe @@ -8,4 +8,6 @@ (funcall f x)) (defun return (x) x) -(defun fail (x) (throw (tuple 'error x))) + +(defun fail (x) + (throw (tuple 'error x))) diff --git a/src/calrissian-maybe-monad.lfe b/src/calrissian-maybe-monad.lfe index 77160b5..e19ac6f 100644 --- a/src/calrissian-maybe-monad.lfe +++ b/src/calrissian-maybe-monad.lfe @@ -10,5 +10,8 @@ (((tuple 'just x) f) (funcall f x))) -(defun return (x) (tuple 'just x)) -(defun fail (_) 'nothing) +(defun return (x) + (tuple 'just x)) + +(defun fail (_) + 'nothing) diff --git a/src/calrissian-monad.lfe b/src/calrissian-monad.lfe index 81a636d..be444c0 100644 --- a/src/calrissian-monad.lfe +++ b/src/calrissian-monad.lfe @@ -9,9 +9,11 @@ ((_) 'undefined)) (defun do-transform - ((monad (cons h '())) h) - ((monad (cons (list f '<- m) t)) (list '>>= monad - m - (list 'lambda (list f) (do-transform monad t)))) - ((monad (cons h t)) (list '>> monad h (do-transform monad t))) - ) + ((monad (cons h '())) + h) + ((monad (cons (list f '<- m) t)) + (list '>>= monad + m + (list 'lambda (list f) (do-transform monad t)))) + ((monad (cons h t)) + (list '>> monad h (do-transform monad t)))) diff --git a/src/calrissian-util.lfe b/src/calrissian-util.lfe index 3055123..e9ace16 100644 --- a/src/calrissian-util.lfe +++ b/src/calrissian-util.lfe @@ -9,27 +9,28 @@ ;; Report exported function arities as (arity - 1) to account for ;; the extra argument supplied to tuple modules (let ((fix-info (lambda (info-plist) - (let* ((exports (: proplists get_value 'exports info-plist)) + (let* ((exports (proplists:get_value 'exports info-plist)) (fix-arity (match-lambda ;; module_info is added by the compiler and therefore remains as-is (((tuple 'module_info arity)) (tuple 'module_info arity)) (((tuple fun arity)) (tuple fun (- arity 1))))) - (info-dict (: dict from_list info-plist)) - (new-dict (: dict store 'exports (: lists map fix-arity exports) info-dict)) - (new-plist (: dict to_list new-dict))) + (info-dict (dict:from_list info-plist)) + (new-dict (dict:store 'exports (lists:map fix-arity exports) info-dict)) + (new-plist (dict:to_list new-dict))) new-plist)))) (funcall fix-info (module-info module)))) - ((module) (call module 'module_info))) + ((module) + (call module 'module_info))) (defun module-info (module key) - (: proplists get_value key (module-info module))) + (proplists:get_value key (module-info module))) (defun implements? (behaviour module) (let* ((exports (module-info module 'exports)) - (exported? (lambda (definition) (: lists member definition exports)))) - (: lists all exported? - (call behaviour 'behaviour_info 'callbacks)))) + (exported? (lambda (definition) (lists:member definition exports)))) + (lists:all exported? + (call behaviour 'behaviour_info 'callbacks)))) (defun exports? (definition module) - (: lists member definition - (module-info module 'exports))) \ No newline at end of file + (lists:member definition + (module-info module 'exports))) From 1c9fe229cb3e7172ecfa32aa229b4c87cac44fe3 Mon Sep 17 00:00:00 2001 From: Duncan McGreggor Date: Thu, 21 May 2015 18:20:06 -0500 Subject: [PATCH 2/5] Updated formatting to use data forms. --- src/calrissian-error-monad.lfe | 10 ++++----- src/calrissian-identity-monad.lfe | 2 +- src/calrissian-maybe-monad.lfe | 4 ++-- src/calrissian-monad.lfe | 20 ++++++++--------- src/calrissian-state-transformer.lfe | 32 ++++++++++++++-------------- src/calrissian-state.lfe | 14 ++++++------ src/calrissian-util.lfe | 6 +++--- 7 files changed, 44 insertions(+), 44 deletions(-) diff --git a/src/calrissian-error-monad.lfe b/src/calrissian-error-monad.lfe index 0beffd0..a76e8a7 100644 --- a/src/calrissian-error-monad.lfe +++ b/src/calrissian-error-monad.lfe @@ -5,9 +5,9 @@ (fail 1))) (defun >>= - (((tuple 'error reason) f) - (tuple 'error reason)) - (((tuple 'ok value) f) + ((`#(error ,reason) f) + `#(error ,reason)) + ((`#(ok ,value) f) (funcall f value)) (('ok f) (funcall f 'ok))) @@ -16,7 +16,7 @@ (('ok) 'ok) ((x) - (tuple 'ok x))) + `#(ok ,x))) (defun fail (reason) - (tuple 'error reason)) + `#(error ,reason)) diff --git a/src/calrissian-identity-monad.lfe b/src/calrissian-identity-monad.lfe index 4be2a99..6eb1af4 100644 --- a/src/calrissian-identity-monad.lfe +++ b/src/calrissian-identity-monad.lfe @@ -10,4 +10,4 @@ (defun return (x) x) (defun fail (x) - (throw (tuple 'error x))) + (throw `#(error ,x))) diff --git a/src/calrissian-maybe-monad.lfe b/src/calrissian-maybe-monad.lfe index e19ac6f..25a728b 100644 --- a/src/calrissian-maybe-monad.lfe +++ b/src/calrissian-maybe-monad.lfe @@ -7,11 +7,11 @@ (defun >>= (('nothing f) 'nothing) - (((tuple 'just x) f) + ((`#(just ,x) f) (funcall f x))) (defun return (x) - (tuple 'just x)) + `#(just ,x)) (defun fail (_) 'nothing) diff --git a/src/calrissian-monad.lfe b/src/calrissian-monad.lfe index be444c0..d2bafc7 100644 --- a/src/calrissian-monad.lfe +++ b/src/calrissian-monad.lfe @@ -3,17 +3,17 @@ (do-transform 2))) (defun behaviour_info - (('callbacks) (list #(>>= 2) - #(return 1) - #(fail 1))) + (('callbacks) '(#(>>= 2) + #(return 1) + #(fail 1))) ((_) 'undefined)) (defun do-transform - ((monad (cons h '())) + ((monad `(,h . ())) h) - ((monad (cons (list f '<- m) t)) - (list '>>= monad - m - (list 'lambda (list f) (do-transform monad t)))) - ((monad (cons h t)) - (list '>> monad h (do-transform monad t)))) + ((monad `((,f <- ,m) . ,t)) + `(>>= ,monad + ,m + (lambda (,f) ,(do-transform monad t)))) + ((monad `(,h . ,t)) + `(>> ,monad ,h ,(do-transform monad t)))) diff --git a/src/calrissian-state-transformer.lfe b/src/calrissian-state-transformer.lfe index eb30588..052b05a 100644 --- a/src/calrissian-state-transformer.lfe +++ b/src/calrissian-state-transformer.lfe @@ -4,57 +4,57 @@ (include-lib "include/monads.lfe") (defun new (inner-monad) - (tuple 'calrissian-state-transformer inner-monad)) + `#(calrissian-state-transformer ,inner-monad)) (defun return - ((x (tuple 'calrissian-state-transformer inner-monad)) + ((x `#(calrissian-state-transformer ,inner-monad)) (lambda (s) (call inner-monad 'return (tuple x s))))) (defun fail - ((reason (tuple 'calrissian-state-transformer inner-monad)) + ((reason `#(calrissian-state-transformer ,inner-monad)) (lambda (_) (call inner-monad 'fail reason)))) (defun >>= - ((x f (tuple 'calrissian-state-transformer inner-monad)) + ((x f `#(calrissian-state-transformer ,inner-monad)) (lambda (s) (call inner-monad '>>= (funcall x s) - (match-lambda (((tuple x1 s1)) (funcall (funcall f x1) s1))))))) + (match-lambda ((`#(,x1 ,s1)) (funcall (funcall f x1) s1))))))) (defun get (_) (lambda (s) - (tuple s s))) + `#(,s ,s))) (defun put (s _) (lambda (_) - (tuple 'ok s))) + `#(ok ,s))) (defun modify - ((f (tuple 'calrissian-state-transformer inner-monad)) + ((f `#(calrissian-state-transformer ,inner-monad)) (lambda (s) - (tuple 'ok (call inner-monad 'return (funcall f s)))))) + `#(ok ,(call inner-monad 'return (funcall f s)))))) (defun modify-and-return - ((f (tuple 'calrissian-state-transformer inner-monad)) + ((f `#(calrissian-state-transformer ,inner-monad)) (lambda (s) (let ((newstate (call inner-monad 'return (funcall f s)))) - (tuple newstate newstate))))) + `#(,newstate ,newstate))))) (defun eval - ((m s (tuple 'calrissian-state-transformer inner-monad)) + ((m s `#(calrissian-state-transformer ,inner-monad)) (call inner-monad '>>= (funcall m s) - (match-lambda (((tuple x s1)) + (match-lambda ((`#(,x ,s1)) (call inner-monad 'return x)))))) (defun exec - ((m s (tuple 'calrissian-state-transformer inner-monad)) + ((m s `#(calrissian-state-transformer ,inner-monad)) (call inner-monad '>>= (funcall m s) - (match-lambda (((tuple x s1)) + (match-lambda ((`#(,x ,s1)) (call inner-monad 'return s1)))))) (defun run - ((m s (tuple 'calrissian-state-transformer inner-monad)) + ((m s `#(calrissian-state-transformer ,inner-monad)) (funcall m s))) diff --git a/src/calrissian-state.lfe b/src/calrissian-state.lfe index 6fc37a0..b35f703 100644 --- a/src/calrissian-state.lfe +++ b/src/calrissian-state.lfe @@ -2,11 +2,11 @@ (export (behaviour_info 1))) (defun behaviour_info - (('callbacks) (list #(run 2) - #(get 0) - #(put 1) - #(modify 1) - #(modify-and-return 1) - #(exec 2) - #(eval 2))) + (('callbacks) `(#(run 2) + #(get 0) + #(put 1) + #(modify 1) + #(modify-and-return 1) + #(exec 2) + #(eval 2))) ((_) 'undefined)) \ No newline at end of file diff --git a/src/calrissian-util.lfe b/src/calrissian-util.lfe index a36fddf..6fb31a1 100644 --- a/src/calrissian-util.lfe +++ b/src/calrissian-util.lfe @@ -14,15 +14,15 @@ `(#(calrissian ,(get-version))))) (defun module-info - (((tuple module _args)) + ((`#(,module ,_args)) ;; Report exported function arities as (arity - 1) to account for ;; the extra argument supplied to tuple modules (let ((fix-info (lambda (info-plist) (let* ((exports (proplists:get_value 'exports info-plist)) (fix-arity (match-lambda ;; module_info is added by the compiler and therefore remains as-is - (((tuple 'module_info arity)) (tuple 'module_info arity)) - (((tuple fun arity)) (tuple fun (- arity 1))))) + ((`#(module_info ,arity)) `#(module_info ,arity)) + ((`#(,fun ,arity)) `#(,fun ,(- arity 1))))) (info-dict (dict:from_list info-plist)) (new-dict (dict:store 'exports (lists:map fix-arity exports) info-dict)) (new-plist (dict:to_list new-dict))) From 8fbb180c7c715f3a0eb6346a5965bdee3634a454 Mon Sep 17 00:00:00 2001 From: Duncan McGreggor Date: Thu, 21 May 2015 19:14:39 -0500 Subject: [PATCH 3/5] More formatting tweaks. --- include/monads.lfe | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/include/monads.lfe b/include/monads.lfe index 59f2c19..5904a49 100644 --- a/include/monads.lfe +++ b/include/monads.lfe @@ -3,14 +3,14 @@ ;; Provide the state monad in terms of the state transformer (''state `(transformer 'state 'identity)) (_ - `(list_to_atom (lists:flatten (list "calrissian-" - (atom_to_list ,name) - "-monad")))))) + `(list_to_atom (lists:flatten `("calrissian-" + ,(atom_to_list ,name) + "-monad")))))) (defmacro transformer (name inner-monad) - `(tuple (list_to_atom (lists:flatten (list "calrissian-" - (atom_to_list ,name) - "-transformer"))) + `(tuple (list_to_atom (lists:flatten `("calrissian-" + ,(atom_to_list ,name) + "-transformer"))) (monad ,inner-monad))) (defmacro do-m args @@ -31,7 +31,7 @@ `(call ,monad 'fail ,expr)) (defmacro sequence (monad list) - `(: lists foldr + `(lists:foldr (lambda (m acc) (mcons ,monad m acc)) (return ,monad []) ,list)) From e23ab8f4484c619d18ec423a2964f7bf1944ddc7 Mon Sep 17 00:00:00 2001 From: "Duncan M. McGreggor" Date: Thu, 21 May 2015 20:56:59 -0500 Subject: [PATCH 4/5] Removed trailing whitespace. --- include/monad-tests.lfe | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/include/monad-tests.lfe b/include/monad-tests.lfe index 7630bba..5695954 100644 --- a/include/monad-tests.lfe +++ b/include/monad-tests.lfe @@ -43,32 +43,32 @@ (f (lambda (n) (return ,monad (* 3 n))))) (is-equal-m ,monad (>>= ,monad (return ,monad a) f) (funcall f a)))) - + (deftest monad-right-identity (let ((m (return ,monad 3))) (is-equal-m ,monad (>>= ,monad m (lambda (m') (return ,monad m'))) m))) - + (deftest monad-associativity (let ((m (return ,monad 3)) (f (lambda (n) (return ,monad (* 3 n)))) (g (lambda (n) (return ,monad (+ 5 n))))) (is-equal-m ,monad (>>= ,monad (>>= ,monad m f) g) (>>= ,monad m (lambda (x) (>>= ,monad (funcall f x) g)))))) - + (deftest monad-do-left-identity (let ((a 3) (f (lambda (n) (return ,monad (* 3 n))))) (is-equal-m ,monad (do-m ,monad (a' <- (return ,monad a)) (funcall f a')) (do-m ,monad (funcall f a))))) - + (deftest monad-do-right-identity (let ((m (return ,monad 3))) (is-equal-m ,monad (do-m ,monad (x <- m) (return ,monad x)) (do-m ,monad m)))) - + (deftest monad-do-associativity (let ((m (return ,monad 3)) (f (lambda (n) (return ,monad (* 3 n)))) From b3bd0f601511e41ee1a45488d05860124bb5f1d0 Mon Sep 17 00:00:00 2001 From: "Duncan M. McGreggor" Date: Thu, 21 May 2015 20:57:48 -0500 Subject: [PATCH 5/5] Updated to new call syntax. --- include/monad-tests.lfe | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/monad-tests.lfe b/include/monad-tests.lfe index 5695954..19b3301 100644 --- a/include/monad-tests.lfe +++ b/include/monad-tests.lfe @@ -1,5 +1,5 @@ (defmacro evaluate-m (monad mval) - `(cond ((: calrissian-util implements? 'calrissian-state ,monad) + `(cond ((calrissian-util:implements? 'calrissian-state ,monad) (call ,monad 'run ,mval 'undefined)) ('true ,mval)))