path: root/source/test2.lux

## (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 "./"))
      )
    ))