(.module: [lux #- not or and list if function cond] (lux (control pipe) (data [text] text/format [number] (coll [list "list/" Functor Fold])) (type abstract))) (abstract: #export Single {} Unit) (abstract: #export Poly {} Unit) (abstract: #export (Var kind) {} Text (def: name (All [k] (-> (Var k) Text)) (|>> @representation)) (def: #export var (-> Text (Var Single)) (|>> @abstraction)) (def: #export var-args (Var Poly) (@abstraction "...")) ) (type: #export SVar (Var Single)) (type: #export PVar (Var Poly)) (abstract: #export Expression {} Text (def: #export expression (-> Expression Text) (|>> @representation)) (def: #export code (-> Text Expression) (|>> @abstraction)) (def: (self-contained code) (-> Text Text) (format "(" code ")")) (def: #export null Expression (|> "NULL" self-contained @abstraction)) (def: #export n/a Expression (|> "NA" self-contained @abstraction)) (def: #export not-available Expression n/a) (def: #export not-applicable Expression n/a) (def: #export no-answer Expression n/a) (def: #export bool (-> Bool Expression) (|>> (case> true "TRUE" false "FALSE") self-contained @abstraction)) (def: #export (int value) (-> Int Expression) (@abstraction (self-contained (format "as.integer(" (%i value) ")")))) (def: #export float (-> Frac Expression) (|>> (cond> [(f/= number.positive-infinity)] [(new> "1.0/0.0")] [(f/= number.negative-infinity)] [(new> "-1.0/0.0")] [(f/= number.not-a-number)] [(new> "0.0/0.0")] ## else [%f]) self-contained @abstraction)) (def: #export string (-> Text Expression) (|>> %t self-contained @abstraction)) (def: (composite-literal left-delimiter right-delimiter entry-serializer) (All [a] (-> Text Text (-> a Text) (-> (List a) Expression))) (.function (_ entries) (@abstraction (self-contained (format left-delimiter (|> entries (list/map entry-serializer) (text.join-with ",")) right-delimiter))))) (def: #export named-list (-> (List [Text Expression]) Expression) (composite-literal "list(" ")" (.function (_ [key value]) (format key "=" (@representation value))))) (do-template [ ] [(def: #export (-> (List Expression) Expression) (composite-literal (format "(") ")" expression))] [vector "c"] [list "list"] ) (def: #export (slice from to list) (-> Expression Expression Expression Expression) (@abstraction (self-contained (format (@representation list) "[" (@representation from) ":" (@representation to) "]")))) (def: #export (slice-from from list) (-> Expression Expression Expression) (@abstraction (self-contained (format (@representation list) "[-1" ":-" (@representation from) "]")))) (def: #export (apply args func) (-> (List Expression) Expression Expression) (@abstraction (self-contained (format (@representation func) "(" (text.join-with "," (list/map expression args)) ")")))) (def: #export (apply-kw args kw-args func) (-> (List Expression) (List [Text Expression]) Expression Expression) (@abstraction (self-contained (format (@representation func) (format "(" (text.join-with "," (list/map expression args)) (text.join-with "," (list/map (.function (_ [key val]) (format key "=" (expression val))) kw-args)) ")"))))) (def: #export (nth idx list) (-> Expression Expression Expression) (@abstraction (self-contained (format (@representation list) "[[" (@representation idx) "]]")))) (def: #export (if test then else) (-> Expression Expression Expression Expression) (@abstraction (self-contained (format "if(" (@representation test) ")" " " (@representation then) " else " (@representation else))))) (def: #export (cond clauses else) (-> (List [Expression Expression]) Expression Expression) (list/fold (.function (_ [test then] next) (if test then next)) else (list.reverse clauses))) (do-template [ ] [(def: #export ( param subject) (-> Expression Expression Expression) (@abstraction (self-contained (format (@representation subject) " " " " (@representation param)))))] [= "=="] [< "<"] [<= "<="] [> ">"] [>= ">="] [+ "+"] [- "-"] [* "*"] [/ "/"] [%% "%%"] [** "**"] [or "||"] [and "&&"] ) (def: #export @@ (All [k] (-> (Var k) Expression)) (|>> ..name self-contained @abstraction)) (def: #export global (-> Text Expression) (|>> var @@)) (do-template [ ] [(def: #export ( param subject) (-> Expression Expression Expression) (..apply (.list subject param) (..global )))] [bit-or "bitwOr"] [bit-and "bitwAnd"] [bit-xor "bitwXor"] [bit-shl "bitwShiftL"] [bit-ushr "bitwShiftR"] ) (def: #export (bit-not subject) (-> Expression Expression) (..apply (.list subject) (..global "bitwNot"))) (do-template [ ] [(def: #export (-> Expression Expression) (|>> @representation (format ) self-contained @abstraction))] [not "!"] [negate "-"] ) (def: #export (length list) (-> Expression Expression) (..apply (.list list) (..global "length"))) (def: #export (range from to) (-> Expression Expression Expression) (@abstraction (self-contained (format (@representation from) ":" (@representation to))))) ) (abstract: #export Statement {} Text (def: #export statement (-> Statement Text) (|>> @representation)) (def: nest (-> Statement Text) (|>> @representation (format "\n") (text.replace-all "\n" "\n "))) (def: #export (set-nth! idx value list) (-> Expression Expression SVar Statement) (@abstraction (format (..name list) "[" (expression idx) "] <- " (expression value)))) (def: #export (set! var value) (-> (Var Single) Expression Statement) (@abstraction (format (..name var) " <- " (expression value)))) (def: #export (if! test then! else!) (-> Expression Statement Statement Statement) (@abstraction (format "if(" (expression test) ") {" (nest then!) "\n" "} else {" (nest else!) "\n" "}"))) (def: #export (when! test then!) (-> Expression Statement Statement) (@abstraction (format "if(" (expression test) ") {" (nest then!) "\n" "}"))) (def: #export (cond! clauses else!) (-> (List [Expression Statement]) Statement Statement) (list/fold (.function (_ [test then!] next!) (if! test then! next!)) else! (list.reverse clauses))) (def: #export (then! pre! post!) (-> Statement Statement Statement) (@abstraction (format (@representation pre!) "\n" (@representation post!)))) (def: #export (while! test body!) (-> Expression Statement Statement) (@abstraction (format "while (" (expression test) ") {" (nest body!) "\n" "}"))) (def: #export (do! expression) (-> Expression Statement) (@abstraction (..expression expression))) (def: #export no-op! Statement (@abstraction "\n")) (do-template [ ] [(def: #export ( message) (-> Expression Statement) (@abstraction (format "(" (expression message) ")")))] [stop! "stop"] [print! "print"] ) (def: #export (block statement) (-> Statement Expression) (..code (format "{" (nest statement) "\n" "}"))) (def: #export (for-in! var inputs body!) (-> SVar Expression Statement Statement) (@abstraction (format "for (" (..name var) " in " (..expression inputs) ")" (..expression (..block body!))))) ) (def: #export (function inputs body!) (-> (List (Ex [k] (Var k))) Statement Expression) (let [args (|> inputs (list/map ..name) (text.join-with ", "))] (..code (format "function(" args ")" (..expression (..block body!)))))) (def: #export (try body! warning error finally!) (-> Statement (Maybe Expression) (Maybe Expression) (Maybe Statement) Expression) (..code (format "(tryCatch(" (..expression (..block body!)) (case warning (#.Some warning) (format ", warning = " (..expression warning)) #.None "") (case error (#.Some error) (format ", error = " (..expression error)) #.None "") (case finally! (#.Some finally!) (format ", finally = " (..expression (..block finally!))) #.None "") "))")))