aboutsummaryrefslogtreecommitdiff
path: root/source/util.lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/util.lux')
-rw-r--r--source/util.lux169
1 files changed, 0 insertions, 169 deletions
diff --git a/source/util.lux b/source/util.lux
deleted file mode 100644
index 88b035571..000000000
--- a/source/util.lux
+++ /dev/null
@@ -1,169 +0,0 @@
-(def (fail* message)
- (#Failure message))
-
-(def (return* state value)
- (#Ok [state value]))
-
-(def (fail message)
- (lambda [state]
- (#Failure message)))
-
-(def (return value)
- (lambda [state]
- (#Ok [state value])))
-
-(def (bind m-value step)
- (lambda [state]
- (let inputs (m-value state)
- (case inputs
- (#Ok [?state ?datum])
- (step ?datum ?state)
-
- _
- inputs))))
-
-## Ideally, this is what I want...
-## (exec [yolo lol
-## #let [foo (bar 1 2 3)]]
-## (meme yolo foo))
-
-(defmacro (exec tokens)
- (case tokens
- (#Cons (#Tuple steps) (#Cons value #Nil))
- (fold (lambda [inner pair]
- (case pair
- [label computation]
- (' (bind (~ computation) (lambda [(~ label)] (~ inner))))))
- value
- (pairs steps))))
-
-(def (try-m monad)
- (lambda [state]
- (case (monad state)
- (#Ok [?state ?datum])
- (return* ?state (#Just ?datum))
-
- (#Failure _)
- (return* state #Nothing))))
-
-(def (repeat-m monad)
- (lambda [state]
- (case (monad state)
- (#Ok [?state ?head])
- (case ((repeat-m monad) ?state)
- (#Ok [?state* ?tail])
- (return* ?state* (#Cons ?head ?tail)))
-
- (#Failure ?message)
- (return* state #Nil))))
-
-(def (try-all-m monads)
- (lambda [state]
- (case monads
- #Nil
- (fail* "No alternative worked!")
- (#Cons monad monads')
- (let output (monad state)
- (case output
- (#Ok _)
- output
-
- (#Failure _)
- (case monads'
- #Nil
- output
- (#Cons _ _)
- ((try-all-m monads') state))
- ))
- )))
-
-(def (map-m f inputs)
- (case inputs
- #Nil
- (return #Nil)
- (#Cons input inputs')
- (exec [output (f input)
- outputs (map-m f inputs')]
- (return (#Cons output outputs)))))
-
-(def (fold-m f init inputs)
- (case inputs
- #Nil (return init)
- (#Cons x inputs') (exec [init* (f init x)]
- (fold-m f init* inputs'))))
-
-(def (apply-m monad call-state)
- (lambda [state]
- (let output (monad call-state)
- (case output
- (#Ok [?state ?datum])
- (#Ok [state ?datum])
-
- _
- output))))
-
-(def (assert test message)
- (if test
- (return [])
- (fail message)))
-
-(def (pass %value)
- (lambda [state]
- %value))
-
-(def get-state
- (lambda [state]
- (return* state state)))
-
-(def (normalize-char char)
- (case char
- #"*" "_ASTER_"
- #"+" "_PLUS_"
- #"-" "_DASH_"
- #"/" "_SLASH_"
- #"_" "_UNDERS_"
- #"%" "_PERCENT_"
- #"$" "_DOLLAR_"
- #"'" "_QUOTE_"
- #"`" "_BQUOTE_"
- #"@" "_AT_"
- #"^" "_CARET_"
- #"&" "_AMPERS_"
- #"=" "_EQ_"
- #"!" "_BANG_"
- #"?" "_QM_"
- #":" "_COLON_"
- #";" "_SCOLON_"
- #"." "_PERIOD_"
- #"," "_COMMA_"
- #"<" "_LT_"
- #">" "_GT_"
- #"~" "_TILDE_"
- ##;;#"\" "_BSLASH_"
- _ (show char)
- ))
-
-(def (normalize-ident ident)
- (fold concat "" (map normalize-char (text->list ident))))
-
-(def (within slot monad)
- (lambda [state]
- (let =return (monad (get slot state))
- (case =return
- (#Ok ?state ?value)
- (#Ok (put slot ?state state) ?value)
-
- _
- =return))))
-
-(def (run-state monad state)
- (monad state))
-
-(def (fresh-class-loader path)
- (let file (jvm/new java.io.File [String] [path])
- (let url (jvm/invokevirtual java.io.File "toURL" []
- file [])
- (let urls (jvm/new-array java.net.URL 1)
- (do (jvm/aastore urls 0 url)
- (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls]))))
- ))