diff options
author | Eduardo Julian | 2015-01-19 01:45:02 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-01-19 01:45:02 -0400 |
commit | a14d86d958af652f7bc4ce669dffcc100d2a084c (patch) | |
tree | 1fa81db7a1d478ee2f1c72b107970250b0c8df0d /test2.lux | |
parent | a1d619ac4679f246a92ee5e557ed1341f5629221 (diff) |
[Enhancements]
Source code is looked-up inside a "source" directory.
Diffstat (limited to 'test2.lux')
-rw-r--r-- | test2.lux | 491 |
1 files changed, 0 insertions, 491 deletions
diff --git a/test2.lux b/test2.lux deleted file mode 100644 index d036bbde4..000000000 --- a/test2.lux +++ /dev/null @@ -1,491 +0,0 @@ -## (use "./another" as another) - -(jvm/definterface Function - (: apply (-> [java.lang.Object] java.lang.Object))) - -(jvm/defclass Tuple0 java.lang.Object - []) -(jvm/defclass Tuple1 java.lang.Object - [[java.lang.Object _1]]) -(jvm/defclass Tuple2 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2]]) -(jvm/defclass Tuple3 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3]]) -(jvm/defclass Tuple4 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4]]) -(jvm/defclass Tuple5 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5]]) -(jvm/defclass Tuple6 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6]]) -(jvm/defclass Tuple7 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7]]) -(jvm/defclass Tuple8 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7] [java.lang.Object _8]]) - -(jvm/defclass Variant java.lang.Object - [[java.lang.String tag]]) -(jvm/defclass Variant0 test2.Variant - []) -(jvm/defclass Variant1 test2.Variant - [[java.lang.Object _1]]) -(jvm/defclass Variant2 test2.Variant - [[java.lang.Object _1] [java.lang.Object _2]]) -(jvm/defclass Variant3 test2.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3]]) -(jvm/defclass Variant4 test2.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4]]) -(jvm/defclass Variant5 test2.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5]]) -(jvm/defclass Variant6 test2.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6]]) -(jvm/defclass Variant7 test2.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7]]) -(jvm/defclass Variant8 test2.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7] [java.lang.Object _8]]) - -(def (print x) - (jvm/invokevirtual java.io.PrintStream "print" [Object] - (jvm/getstatic System out) [x])) - -(def (println x) - (jvm/invokevirtual java.io.PrintStream "println" [Object] - (jvm/getstatic System out) [x])) - -(defmacro (list xs) - (case xs - #Nil - (#Tag "Nil") - - (#Cons x xs*) - (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil)))))) - -(def (++ xs ys) - (case xs - #Nil - ys - - (#Cons x xs*) - (#Cons x (++ xs* ys)))) - -(def (map f xs) - (case xs - #Nil - #Nil - - (#Cons x xs*) - (#Cons (f x) (map f xs*)))) - -(def (untemplate-list untemplate tokens) - (case tokens - #Nil - (#Tag "Nil") - - (#Cons token tokens') - (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens'))))) - -(def (untemplate token) - (case token - (#Bool elem) - (#Form (list (#Tag "Bool") (#Bool elem))) - - (#Int elem) - (#Form (list (#Tag "Int") (#Int elem))) - - (#Real elem) - (#Form (list (#Tag "Real") (#Real elem))) - - (#Char elem) - (#Form (list (#Tag "Char") (#Char elem))) - - (#Text elem) - (#Form (list (#Tag "Text") (#Text elem))) - - (#Tag elem) - (#Form (list (#Tag "Tag") (#Text elem))) - - (#Ident elem) - (#Form (list (#Tag "Ident") (#Text elem))) - - (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil))) - unquoted - - (#Tuple elems) - (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems))) - - (#Form elems) - (#Form (list (#Tag "Form") (untemplate-list untemplate elems))) - )) - -(defmacro (' form) - (case form - (#Cons token #Nil) - (untemplate token))) - -## Utils -(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)))) - -(def (+ x y) - (jvm/i+ x y)) - -(def inc (+ 1)) - -(def (id x) - x) - -(def (fold f init values) - (case values - #Nil - init - (#Cons x xs) - (fold f (f init x) xs))) - -(def length (fold (lambda [l x] (inc l)) 0)) - -(def (rem dividend divisor) - (jvm/irem dividend divisor)) - -(def (= x y) - (jvm/invokevirtual Object "equals" [Object] - x [y])) - -(def (as-pairs list) - (case list - (#Cons x (#Cons y list*)) - (#Cons [x y] (as-pairs list*)) - - _ - #Nil)) - -## 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 return #Nil)) - (if (= 0 (rem (length steps) 2)) - (fold (lambda [inner pair] - (case pair - [label computation] - (' (bind (~ computation) - (lambda [(~ label)] (~ inner)))))) - return - (as-pairs steps)) - (#Text "Oh no!")))) - -(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 (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 (= from to) - #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 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 (jvm/new-array java.net.URL 1) - (do (jvm/aastore urls 0 url) - (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls])))) - )) - -(def (cons tail head) - (#Cons head tail)) - -(def (reverse list) - (fold cons #Nil list)) - -(def (enumerate list) - (case (fold (lambda [state x] - (case state - [idx list'] - [(inc idx) (#Cons [idx x] list')])) - [0 #Nil] - list) - [_ list'] - (reverse list'))) - -(def (print-enum enum) - (case enum - #Nil - (println "") - - (#Cons [idx x] enum') - (do (print "[") (print idx) (print ":") (print x) (print "]") (print " ") - (print-enum enum')))) - -(def get-state - (lambda [state] - (#Ok [state 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 (within slot monad) - (lambda [state] - (let =return (monad (get slot state)) - (case =return - (#Ok ?state ?value) - (#Ok (put slot ?state state) ?value) - - _ - =return)))) - -(def monadic-dup - (exec [foo get-state - bar get-state - baz (return 1000)] - (return (+ (+ foo bar) baz)))) - -(def (run-state monad state) - (monad state)) - -(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..."))) - (#Form (#Cons text #Nil)) - (do (println text) - (println (+ 10 20)) - (println (inc 10)) - (println (jvm/i- 10 20)) - (println (jvm/i* 10 20)) - (println (jvm/i/ 10 2)) - (let xs (list 1 2 3 4 5 6 7 8 9) - (do (println (fold + 0 xs)) - (println (length xs)))) - (println (rem 21 6)) - (println (rem 21 7)) - (println (= false false)) - (println (= false true)) - (println (= true false)) - (println (= true true)) - (case (run-state monadic-dup 123) - (#Ok [_ ?value]) - (println ?value) - - (#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))) - (println (normalize-ident "text->list")) - (println (fresh-class-loader "./")) - ) - )) |