aboutsummaryrefslogtreecommitdiff
path: root/test2.lux
diff options
context:
space:
mode:
Diffstat (limited to 'test2.lux')
-rw-r--r--test2.lux149
1 files changed, 149 insertions, 0 deletions
diff --git a/test2.lux b/test2.lux
index e5e3ad6da..c3854ab19 100644
--- a/test2.lux
+++ b/test2.lux
@@ -269,6 +269,103 @@
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 (show x)
+ (jvm/invokevirtual Object "toString" []
+ x []))
+
+(def (concat t1 t2)
+ (jvm/invokevirtual String "concat" [String]
+ t1 [t2]))
+
+(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 (range from to)
+ (if (= to from)
+ #Nil
+ (#Cons from (range (inc from) to))))
+
+#(
+ (def (text->list text)
+ (let length (jvm/invokevirtual String "length" []
+ text [])
+ (map (lambda [idx]
+ (jvm/invokevirtual String "charAt" [int]
+ text [idx]))
+ (range-to 0 length))))
+
+ (def (normalize-ident ident)
+ (fold concat "" (map normalize-char (text->list ident))))
+
+ (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 (array java.net.URL (list url))
+ (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls])))))
+
+ (def (fresh-class-loader path)
+ (let [file (jvm/new java.io.File [String] [path])
+ url (jvm/invokevirtual java.io.File "toURL" []
+ file [])
+ urls (array java.net.URL (list url))]
+ (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls])))
+ )#
+
(def (cons tail head)
(#Cons head tail))
@@ -307,6 +404,53 @@
(def (run-state monad state)
(monad state))
+(def list-map #Nil)
+
+(def (put key val map)
+ (case map
+ #Nil
+ (#Cons [key val] map)
+
+ (#Cons [?key ?val] map')
+ (if (= key ?key)
+ (#Cons [?key val] map')
+ (#Cons [?key ?val] (put key val map')))))
+
+(def (get key map)
+ (case map
+ #Nil
+ #None
+
+ (#Cons [?key ?val] map')
+ (if (= key ?key)
+ (#Some ?val)
+ (get key map'))))
+
+(def (show-kv kv)
+ (case kv
+ [?key ?val]
+ (fold concat "" (list "#" ?key " " (show ?val)))))
+
+(def (interpose elem list)
+ (case list
+ (#Cons x (#Cons y list'))
+ (#Cons x (#Cons elem (#Cons y list')))
+
+ _
+ list))
+
+(def (print-map list-map)
+ (do (print "{")
+ (print (fold concat "" (interpose " " (map show-kv list-map))))
+ (println "}")))
+
+(def (show-list xs)
+ (case xs
+ #Nil
+ "#Nil"
+ (#Cons x xs')
+ (fold concat "" (list "(#Cons " (show x) " " (show-list xs') ")"))))
+
## Program
(def (main args)
(case (' ((~ "Oh yeah...")))
@@ -333,6 +477,11 @@
(#Failure ?message)
(println ?message))
(print-enum (enumerate (list #"a" #"b" #"c" #"d" #"e")))
+ (print-map (put "Nyan" "cat" (put "Yolo" "lol" list-map)))
+ (let char #"*"
+ (do (print (show char)) (print " -> ")
+ (println (normalize-char char))))
+ (println (show-list (range 0 10)))
)
))