From 5a56806146d0bbf8309752f11fe601cf04624047 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 16 Jan 2015 14:25:32 -0400
Subject: [Bugs] - Char pattern-matching is now handled better and defaults now
 work for it. - Text pattern-matching is now handled better and defaults now
 work for it.

---
 test2.lux | 149 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 149 insertions(+)

(limited to 'test2.lux')

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)))
       )
     ))
 
-- 
cgit v1.2.3