From 69d3bdf98a5be8dd7aacc0b37bdbfcbf226faf62 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 6 Nov 2017 20:51:43 -0400 Subject: - Changed how Lux procedures work on the old compiler and the stdlib. --- luxc/src/lux/analyser.clj | 32 ++- luxc/src/lux/analyser/proc/common.clj | 285 ++++++++++------------- luxc/src/lux/analyser/proc/jvm.clj | 308 +++++++++++++------------ stdlib/source/lux.lux | 172 +++++++------- stdlib/source/lux/concurrency/atom.lux | 10 +- stdlib/source/lux/concurrency/promise.lux | 8 +- stdlib/source/lux/data/bit.lux | 18 +- stdlib/source/lux/data/coll/array.lux | 10 +- stdlib/source/lux/data/coll/list.lux | 4 +- stdlib/source/lux/data/coll/priority-queue.lux | 4 +- stdlib/source/lux/data/number.lux | 200 ++++++++-------- stdlib/source/lux/data/text.lux | 46 ++-- stdlib/source/lux/host.js.lux | 20 +- stdlib/source/lux/host.jvm.lux | 198 ++++++++-------- stdlib/source/lux/math.lux | 46 ++-- stdlib/source/lux/meta/syntax.lux | 2 +- stdlib/source/lux/test.lux | 4 +- stdlib/source/lux/time/instant.lux | 2 +- stdlib/test/test/lux.lux | 8 +- stdlib/test/test/lux/host.jvm.lux | 4 +- 20 files changed, 669 insertions(+), 712 deletions(-) diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 2d029155e..6fc5986ac 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -108,8 +108,8 @@ (&/$Form (&/$Cons [command-meta command] parameters)) (|case command - (&/$Text command-name) - (case command-name + (&/$Text ?procedure) + (case ?procedure "lux check" (|let [(&/$Cons ?type (&/$Cons ?value @@ -158,26 +158,20 @@ (&&lux/analyse-function analyse exo-type ?self ?arg ?body))) ;; else - (&/fail-with-loc (str "[Analyser Error] Unknown syntax: " (&/show-ast (&/T [(&/T ["" -1 -1]) token]))))) + (&/with-analysis-meta cursor exo-type + (cond (.startsWith ^String ?procedure "jvm") + (|do [_ &/jvm-host] + (&&jvm/analyse-host analyse exo-type compilers ?procedure parameters)) + + (.startsWith ^String ?procedure "js") + (|do [_ &/js-host] + (&&js/analyse-host analyse exo-type ?procedure parameters)) + + :else + (&&common/analyse-proc analyse exo-type ?procedure parameters)))) (&/$Symbol _ command-name) (case command-name - "_lux_proc" - (|let [(&/$Cons [_ (&/$Tuple (&/$Cons [_ (&/$Text ?category)] - (&/$Cons [_ (&/$Text ?proc)] - (&/$Nil))))] - (&/$Cons [_ (&/$Tuple ?args)] - (&/$Nil))) parameters] - (&/with-analysis-meta cursor exo-type - (case ?category - "jvm" (|do [_ &/jvm-host] - (&&jvm/analyse-host analyse exo-type compilers ?proc ?args)) - "js" (|do [_ &/js-host] - (&&js/analyse-host analyse exo-type ?proc ?args)) - ;; common - (&&common/analyse-proc analyse exo-type ?category ?proc ?args)) - )) - "_lux_module" (|let [(&/$Cons ?meta (&/$Nil)) parameters] (&/with-cursor cursor diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index d05c68564..871dec4b3 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -474,161 +474,130 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["process" "schedule"]) (&/|list =milliseconds =procedure) (&/|list))))))) -(defn analyse-proc [analyse exo-type category proc ?values] - (case category - "lux" - (case proc - "is" (analyse-lux-is analyse exo-type ?values) - "try" (analyse-lux-try analyse exo-type ?values)) - - "io" - (case proc - "log" (analyse-io-log analyse exo-type ?values) - "error" (analyse-io-error analyse exo-type ?values) - "exit" (analyse-io-exit analyse exo-type ?values) - "current-time" (analyse-io-current-time analyse exo-type ?values) - ) - - "text" - (case proc - "=" (analyse-text-eq analyse exo-type ?values) - "<" (analyse-text-lt analyse exo-type ?values) - "append" (analyse-text-append analyse exo-type ?values) - "clip" (analyse-text-clip analyse exo-type ?values) - "index" (analyse-text-index analyse exo-type ?values) - "last-index" (analyse-text-last-index analyse exo-type ?values) - "size" (analyse-text-size analyse exo-type ?values) - "hash" (analyse-text-hash analyse exo-type ?values) - "replace-all" (analyse-text-replace-all analyse exo-type ?values) - "trim" (analyse-text-trim analyse exo-type ?values) - "char" (analyse-text-char analyse exo-type ?values) - "upper-case" (analyse-text-upper-case analyse exo-type ?values) - "lower-case" (analyse-text-lower-case analyse exo-type ?values) - "contains?" (analyse-text-contains? analyse exo-type ?values) - ) - - "bit" - (case proc - "count" (analyse-bit-count analyse exo-type ?values) - "and" (analyse-bit-and analyse exo-type ?values) - "or" (analyse-bit-or analyse exo-type ?values) - "xor" (analyse-bit-xor analyse exo-type ?values) - "shift-left" (analyse-bit-shift-left analyse exo-type ?values) - "shift-right" (analyse-bit-shift-right analyse exo-type ?values) - "unsigned-shift-right" (analyse-bit-unsigned-shift-right analyse exo-type ?values)) - - "array" - (case proc - "new" (analyse-array-new analyse exo-type ?values) - "get" (analyse-array-get analyse exo-type ?values) - "put" (analyse-array-put analyse exo-type ?values) - "remove" (analyse-array-remove analyse exo-type ?values) - "size" (analyse-array-size analyse exo-type ?values)) - - "nat" - (case proc - "+" (analyse-nat-add analyse exo-type ?values) - "-" (analyse-nat-sub analyse exo-type ?values) - "*" (analyse-nat-mul analyse exo-type ?values) - "/" (analyse-nat-div analyse exo-type ?values) - "%" (analyse-nat-rem analyse exo-type ?values) - "=" (analyse-nat-eq analyse exo-type ?values) - "<" (analyse-nat-lt analyse exo-type ?values) - "min-value" (analyse-nat-min-value analyse exo-type ?values) - "max-value" (analyse-nat-max-value analyse exo-type ?values) - "to-int" (analyse-nat-to-int analyse exo-type ?values) - "to-char" (analyse-nat-to-char analyse exo-type ?values) - ) - - "int" - (case proc - "+" (analyse-int-add analyse exo-type ?values) - "-" (analyse-int-sub analyse exo-type ?values) - "*" (analyse-int-mul analyse exo-type ?values) - "/" (analyse-int-div analyse exo-type ?values) - "%" (analyse-int-rem analyse exo-type ?values) - "=" (analyse-int-eq analyse exo-type ?values) - "<" (analyse-int-lt analyse exo-type ?values) - "min-value" (analyse-int-min-value analyse exo-type ?values) - "max-value" (analyse-int-max-value analyse exo-type ?values) - "to-nat" (analyse-int-to-nat analyse exo-type ?values) - "to-frac" (analyse-int-to-frac analyse exo-type ?values) - ) - - "deg" - (case proc - "+" (analyse-deg-add analyse exo-type ?values) - "-" (analyse-deg-sub analyse exo-type ?values) - "*" (analyse-deg-mul analyse exo-type ?values) - "/" (analyse-deg-div analyse exo-type ?values) - "%" (analyse-deg-rem analyse exo-type ?values) - "=" (analyse-deg-eq analyse exo-type ?values) - "<" (analyse-deg-lt analyse exo-type ?values) - "min-value" (analyse-deg-min-value analyse exo-type ?values) - "max-value" (analyse-deg-max-value analyse exo-type ?values) - "to-frac" (analyse-deg-to-frac analyse exo-type ?values) - "scale" (analyse-deg-scale analyse exo-type ?values) - "reciprocal" (analyse-deg-reciprocal analyse exo-type ?values) - ) - - "frac" - (case proc - "+" (analyse-frac-add analyse exo-type ?values) - "-" (analyse-frac-sub analyse exo-type ?values) - "*" (analyse-frac-mul analyse exo-type ?values) - "/" (analyse-frac-div analyse exo-type ?values) - "%" (analyse-frac-rem analyse exo-type ?values) - "=" (analyse-frac-eq analyse exo-type ?values) - "<" (analyse-frac-lt analyse exo-type ?values) - "encode" (analyse-frac-encode analyse exo-type ?values) - "decode" (analyse-frac-decode analyse exo-type ?values) - "smallest-value" (analyse-frac-smallest-value analyse exo-type ?values) - "min-value" (analyse-frac-min-value analyse exo-type ?values) - "max-value" (analyse-frac-max-value analyse exo-type ?values) - "not-a-number" (analyse-frac-not-a-number analyse exo-type ?values) - "positive-infinity" (analyse-frac-positive-infinity analyse exo-type ?values) - "negative-infinity" (analyse-frac-negative-infinity analyse exo-type ?values) - "to-deg" (analyse-frac-to-deg analyse exo-type ?values) - "to-int" (analyse-frac-to-int analyse exo-type ?values) - ) - - "math" - (case proc - "e" (analyse-math-e analyse exo-type ?values) - "pi" (analyse-math-pi analyse exo-type ?values) - "cos" (analyse-math-cos analyse exo-type ?values) - "sin" (analyse-math-sin analyse exo-type ?values) - "tan" (analyse-math-tan analyse exo-type ?values) - "acos" (analyse-math-acos analyse exo-type ?values) - "asin" (analyse-math-asin analyse exo-type ?values) - "atan" (analyse-math-atan analyse exo-type ?values) - "cosh" (analyse-math-cosh analyse exo-type ?values) - "sinh" (analyse-math-sinh analyse exo-type ?values) - "tanh" (analyse-math-tanh analyse exo-type ?values) - "exp" (analyse-math-exp analyse exo-type ?values) - "log" (analyse-math-log analyse exo-type ?values) - "root2" (analyse-math-root2 analyse exo-type ?values) - "root3" (analyse-math-root3 analyse exo-type ?values) - "ceil" (analyse-math-ceil analyse exo-type ?values) - "floor" (analyse-math-floor analyse exo-type ?values) - "round" (analyse-math-round analyse exo-type ?values) - "atan2" (analyse-math-atan2 analyse exo-type ?values) - "pow" (analyse-math-pow analyse exo-type ?values) - ) - - "atom" - (case proc - "new" (analyse-atom-new analyse exo-type ?values) - "get" (analyse-atom-get analyse exo-type ?values) - "compare-and-swap" (analyse-atom-compare-and-swap analyse exo-type ?values) - ) - - "process" - (case proc - "concurrency-level" (analyse-process-concurrency-level analyse exo-type ?values) - "future" (analyse-process-future analyse exo-type ?values) - "schedule" (analyse-process-schedule analyse exo-type ?values) - ) - - ;; else - (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " [category proc])))) +(defn analyse-proc [analyse exo-type proc ?values] + (try (case proc + "lux is" (analyse-lux-is analyse exo-type ?values) + "lux try" (analyse-lux-try analyse exo-type ?values) + + "lux io log" (analyse-io-log analyse exo-type ?values) + "lux io error" (analyse-io-error analyse exo-type ?values) + "lux io exit" (analyse-io-exit analyse exo-type ?values) + "lux io current-time" (analyse-io-current-time analyse exo-type ?values) + + "lux text =" (analyse-text-eq analyse exo-type ?values) + "lux text <" (analyse-text-lt analyse exo-type ?values) + "lux text append" (analyse-text-append analyse exo-type ?values) + "lux text clip" (analyse-text-clip analyse exo-type ?values) + "lux text index" (analyse-text-index analyse exo-type ?values) + "lux text last-index" (analyse-text-last-index analyse exo-type ?values) + "lux text size" (analyse-text-size analyse exo-type ?values) + "lux text hash" (analyse-text-hash analyse exo-type ?values) + "lux text replace-all" (analyse-text-replace-all analyse exo-type ?values) + "lux text trim" (analyse-text-trim analyse exo-type ?values) + "lux text char" (analyse-text-char analyse exo-type ?values) + "lux text upper-case" (analyse-text-upper-case analyse exo-type ?values) + "lux text lower-case" (analyse-text-lower-case analyse exo-type ?values) + "lux text contains?" (analyse-text-contains? analyse exo-type ?values) + + "lux bit count" (analyse-bit-count analyse exo-type ?values) + "lux bit and" (analyse-bit-and analyse exo-type ?values) + "lux bit or" (analyse-bit-or analyse exo-type ?values) + "lux bit xor" (analyse-bit-xor analyse exo-type ?values) + "lux bit shift-left" (analyse-bit-shift-left analyse exo-type ?values) + "lux bit shift-right" (analyse-bit-shift-right analyse exo-type ?values) + "lux bit unsigned-shift-right" (analyse-bit-unsigned-shift-right analyse exo-type ?values) + + "lux array new" (analyse-array-new analyse exo-type ?values) + "lux array get" (analyse-array-get analyse exo-type ?values) + "lux array put" (analyse-array-put analyse exo-type ?values) + "lux array remove" (analyse-array-remove analyse exo-type ?values) + "lux array size" (analyse-array-size analyse exo-type ?values) + + "lux nat +" (analyse-nat-add analyse exo-type ?values) + "lux nat -" (analyse-nat-sub analyse exo-type ?values) + "lux nat *" (analyse-nat-mul analyse exo-type ?values) + "lux nat /" (analyse-nat-div analyse exo-type ?values) + "lux nat %" (analyse-nat-rem analyse exo-type ?values) + "lux nat =" (analyse-nat-eq analyse exo-type ?values) + "lux nat <" (analyse-nat-lt analyse exo-type ?values) + "lux nat min-value" (analyse-nat-min-value analyse exo-type ?values) + "lux nat max-value" (analyse-nat-max-value analyse exo-type ?values) + "lux nat to-int" (analyse-nat-to-int analyse exo-type ?values) + "lux nat to-char" (analyse-nat-to-char analyse exo-type ?values) + + "lux int +" (analyse-int-add analyse exo-type ?values) + "lux int -" (analyse-int-sub analyse exo-type ?values) + "lux int *" (analyse-int-mul analyse exo-type ?values) + "lux int /" (analyse-int-div analyse exo-type ?values) + "lux int %" (analyse-int-rem analyse exo-type ?values) + "lux int =" (analyse-int-eq analyse exo-type ?values) + "lux int <" (analyse-int-lt analyse exo-type ?values) + "lux int min-value" (analyse-int-min-value analyse exo-type ?values) + "lux int max-value" (analyse-int-max-value analyse exo-type ?values) + "lux int to-nat" (analyse-int-to-nat analyse exo-type ?values) + "lux int to-frac" (analyse-int-to-frac analyse exo-type ?values) + + "lux deg +" (analyse-deg-add analyse exo-type ?values) + "lux deg -" (analyse-deg-sub analyse exo-type ?values) + "lux deg *" (analyse-deg-mul analyse exo-type ?values) + "lux deg /" (analyse-deg-div analyse exo-type ?values) + "lux deg %" (analyse-deg-rem analyse exo-type ?values) + "lux deg =" (analyse-deg-eq analyse exo-type ?values) + "lux deg <" (analyse-deg-lt analyse exo-type ?values) + "lux deg min-value" (analyse-deg-min-value analyse exo-type ?values) + "lux deg max-value" (analyse-deg-max-value analyse exo-type ?values) + "lux deg to-frac" (analyse-deg-to-frac analyse exo-type ?values) + "lux deg scale" (analyse-deg-scale analyse exo-type ?values) + "lux deg reciprocal" (analyse-deg-reciprocal analyse exo-type ?values) + + "lux frac +" (analyse-frac-add analyse exo-type ?values) + "lux frac -" (analyse-frac-sub analyse exo-type ?values) + "lux frac *" (analyse-frac-mul analyse exo-type ?values) + "lux frac /" (analyse-frac-div analyse exo-type ?values) + "lux frac %" (analyse-frac-rem analyse exo-type ?values) + "lux frac =" (analyse-frac-eq analyse exo-type ?values) + "lux frac <" (analyse-frac-lt analyse exo-type ?values) + "lux frac encode" (analyse-frac-encode analyse exo-type ?values) + "lux frac decode" (analyse-frac-decode analyse exo-type ?values) + "lux frac smallest-value" (analyse-frac-smallest-value analyse exo-type ?values) + "lux frac min-value" (analyse-frac-min-value analyse exo-type ?values) + "lux frac max-value" (analyse-frac-max-value analyse exo-type ?values) + "lux frac not-a-number" (analyse-frac-not-a-number analyse exo-type ?values) + "lux frac positive-infinity" (analyse-frac-positive-infinity analyse exo-type ?values) + "lux frac negative-infinity" (analyse-frac-negative-infinity analyse exo-type ?values) + "lux frac to-deg" (analyse-frac-to-deg analyse exo-type ?values) + "lux frac to-int" (analyse-frac-to-int analyse exo-type ?values) + + "lux math e" (analyse-math-e analyse exo-type ?values) + "lux math pi" (analyse-math-pi analyse exo-type ?values) + "lux math cos" (analyse-math-cos analyse exo-type ?values) + "lux math sin" (analyse-math-sin analyse exo-type ?values) + "lux math tan" (analyse-math-tan analyse exo-type ?values) + "lux math acos" (analyse-math-acos analyse exo-type ?values) + "lux math asin" (analyse-math-asin analyse exo-type ?values) + "lux math atan" (analyse-math-atan analyse exo-type ?values) + "lux math cosh" (analyse-math-cosh analyse exo-type ?values) + "lux math sinh" (analyse-math-sinh analyse exo-type ?values) + "lux math tanh" (analyse-math-tanh analyse exo-type ?values) + "lux math exp" (analyse-math-exp analyse exo-type ?values) + "lux math log" (analyse-math-log analyse exo-type ?values) + "lux math root2" (analyse-math-root2 analyse exo-type ?values) + "lux math root3" (analyse-math-root3 analyse exo-type ?values) + "lux math ceil" (analyse-math-ceil analyse exo-type ?values) + "lux math floor" (analyse-math-floor analyse exo-type ?values) + "lux math round" (analyse-math-round analyse exo-type ?values) + "lux math atan2" (analyse-math-atan2 analyse exo-type ?values) + "lux math pow" (analyse-math-pow analyse exo-type ?values) + + "lux atom new" (analyse-atom-new analyse exo-type ?values) + "lux atom get" (analyse-atom-get analyse exo-type ?values) + "lux atom compare-and-swap" (analyse-atom-compare-and-swap analyse exo-type ?values) + + "lux process concurrency-level" (analyse-process-concurrency-level analyse exo-type ?values) + "lux process future" (analyse-process-future analyse exo-type ?values) + "lux process schedule" (analyse-process-schedule analyse exo-type ?values) + + ;; else + (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " proc))) + (catch Exception ex + (&/fail-with-loc (str "[Analyser Error] Invalid syntax for procedure: " proc))))) diff --git a/luxc/src/lux/analyser/proc/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj index cd3b8f545..760d0cbfd 100644 --- a/luxc/src/lux/analyser/proc/jvm.clj +++ b/luxc/src/lux/analyser/proc/jvm.clj @@ -899,157 +899,159 @@ (defn analyse-host [analyse exo-type compilers proc ?values] (|let [[_ _ _ compile-class compile-interface] compilers] - (case proc - "synchronized" (analyse-jvm-synchronized analyse exo-type ?values) - "load-class" (analyse-jvm-load-class analyse exo-type ?values) - "throw" (analyse-jvm-throw analyse exo-type ?values) - "null?" (analyse-jvm-null? analyse exo-type ?values) - "null" (analyse-jvm-null analyse exo-type ?values) - "anewarray" (analyse-jvm-anewarray analyse exo-type ?values) - "aaload" (analyse-jvm-aaload analyse exo-type ?values) - "aastore" (analyse-jvm-aastore analyse exo-type ?values) - "arraylength" (analyse-jvm-arraylength analyse exo-type ?values) - "znewarray" (analyse-jvm-znewarray analyse exo-type ?values) - "bnewarray" (analyse-jvm-bnewarray analyse exo-type ?values) - "snewarray" (analyse-jvm-snewarray analyse exo-type ?values) - "inewarray" (analyse-jvm-inewarray analyse exo-type ?values) - "lnewarray" (analyse-jvm-lnewarray analyse exo-type ?values) - "fnewarray" (analyse-jvm-fnewarray analyse exo-type ?values) - "dnewarray" (analyse-jvm-dnewarray analyse exo-type ?values) - "cnewarray" (analyse-jvm-cnewarray analyse exo-type ?values) - "zaload" (analyse-jvm-zaload analyse exo-type ?values) - "zastore" (analyse-jvm-zastore analyse exo-type ?values) - "baload" (analyse-jvm-baload analyse exo-type ?values) - "bastore" (analyse-jvm-bastore analyse exo-type ?values) - "saload" (analyse-jvm-saload analyse exo-type ?values) - "sastore" (analyse-jvm-sastore analyse exo-type ?values) - "iaload" (analyse-jvm-iaload analyse exo-type ?values) - "iastore" (analyse-jvm-iastore analyse exo-type ?values) - "laload" (analyse-jvm-laload analyse exo-type ?values) - "lastore" (analyse-jvm-lastore analyse exo-type ?values) - "faload" (analyse-jvm-faload analyse exo-type ?values) - "fastore" (analyse-jvm-fastore analyse exo-type ?values) - "daload" (analyse-jvm-daload analyse exo-type ?values) - "dastore" (analyse-jvm-dastore analyse exo-type ?values) - "caload" (analyse-jvm-caload analyse exo-type ?values) - "castore" (analyse-jvm-castore analyse exo-type ?values) - "iadd" (analyse-jvm-iadd analyse exo-type ?values) - "isub" (analyse-jvm-isub analyse exo-type ?values) - "imul" (analyse-jvm-imul analyse exo-type ?values) - "idiv" (analyse-jvm-idiv analyse exo-type ?values) - "irem" (analyse-jvm-irem analyse exo-type ?values) - "ieq" (analyse-jvm-ieq analyse exo-type ?values) - "ilt" (analyse-jvm-ilt analyse exo-type ?values) - "igt" (analyse-jvm-igt analyse exo-type ?values) - "ceq" (analyse-jvm-ceq analyse exo-type ?values) - "clt" (analyse-jvm-clt analyse exo-type ?values) - "cgt" (analyse-jvm-cgt analyse exo-type ?values) - "ladd" (analyse-jvm-ladd analyse exo-type ?values) - "lsub" (analyse-jvm-lsub analyse exo-type ?values) - "lmul" (analyse-jvm-lmul analyse exo-type ?values) - "ldiv" (analyse-jvm-ldiv analyse exo-type ?values) - "lrem" (analyse-jvm-lrem analyse exo-type ?values) - "leq" (analyse-jvm-leq analyse exo-type ?values) - "llt" (analyse-jvm-llt analyse exo-type ?values) - "lgt" (analyse-jvm-lgt analyse exo-type ?values) - "fadd" (analyse-jvm-fadd analyse exo-type ?values) - "fsub" (analyse-jvm-fsub analyse exo-type ?values) - "fmul" (analyse-jvm-fmul analyse exo-type ?values) - "fdiv" (analyse-jvm-fdiv analyse exo-type ?values) - "frem" (analyse-jvm-frem analyse exo-type ?values) - "feq" (analyse-jvm-feq analyse exo-type ?values) - "flt" (analyse-jvm-flt analyse exo-type ?values) - "fgt" (analyse-jvm-fgt analyse exo-type ?values) - "dadd" (analyse-jvm-dadd analyse exo-type ?values) - "dsub" (analyse-jvm-dsub analyse exo-type ?values) - "dmul" (analyse-jvm-dmul analyse exo-type ?values) - "ddiv" (analyse-jvm-ddiv analyse exo-type ?values) - "drem" (analyse-jvm-drem analyse exo-type ?values) - "deq" (analyse-jvm-deq analyse exo-type ?values) - "dlt" (analyse-jvm-dlt analyse exo-type ?values) - "dgt" (analyse-jvm-dgt analyse exo-type ?values) - "iand" (analyse-jvm-iand analyse exo-type ?values) - "ior" (analyse-jvm-ior analyse exo-type ?values) - "ixor" (analyse-jvm-ixor analyse exo-type ?values) - "ishl" (analyse-jvm-ishl analyse exo-type ?values) - "ishr" (analyse-jvm-ishr analyse exo-type ?values) - "iushr" (analyse-jvm-iushr analyse exo-type ?values) - "land" (analyse-jvm-land analyse exo-type ?values) - "lor" (analyse-jvm-lor analyse exo-type ?values) - "lxor" (analyse-jvm-lxor analyse exo-type ?values) - "lshl" (analyse-jvm-lshl analyse exo-type ?values) - "lshr" (analyse-jvm-lshr analyse exo-type ?values) - "lushr" (analyse-jvm-lushr analyse exo-type ?values) - "d2f" (analyse-jvm-d2f analyse exo-type ?values) - "d2i" (analyse-jvm-d2i analyse exo-type ?values) - "d2l" (analyse-jvm-d2l analyse exo-type ?values) - "f2d" (analyse-jvm-f2d analyse exo-type ?values) - "f2i" (analyse-jvm-f2i analyse exo-type ?values) - "f2l" (analyse-jvm-f2l analyse exo-type ?values) - "i2b" (analyse-jvm-i2b analyse exo-type ?values) - "i2c" (analyse-jvm-i2c analyse exo-type ?values) - "i2d" (analyse-jvm-i2d analyse exo-type ?values) - "i2f" (analyse-jvm-i2f analyse exo-type ?values) - "i2l" (analyse-jvm-i2l analyse exo-type ?values) - "i2s" (analyse-jvm-i2s analyse exo-type ?values) - "l2d" (analyse-jvm-l2d analyse exo-type ?values) - "l2f" (analyse-jvm-l2f analyse exo-type ?values) - "l2i" (analyse-jvm-l2i analyse exo-type ?values) - "l2s" (analyse-jvm-l2s analyse exo-type ?values) - "l2b" (analyse-jvm-l2b analyse exo-type ?values) - "c2b" (analyse-jvm-c2b analyse exo-type ?values) - "c2s" (analyse-jvm-c2s analyse exo-type ?values) - "c2i" (analyse-jvm-c2i analyse exo-type ?values) - "c2l" (analyse-jvm-c2l analyse exo-type ?values) - "b2l" (analyse-jvm-b2l analyse exo-type ?values) - "s2l" (analyse-jvm-s2l analyse exo-type ?values) - ;; else - (->> (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " ["jvm" proc])) - (if-let [[_ _def-code] (re-find #"^interface:(.*)$" proc)] - (|do [[_module _line _column] &/cursor] - (&reader/with-source (str "interface@" "(" _module "," _line "," _column ")") _def-code - (|do [[=gclass-decl =supers =anns =methods] &&a-parser/parse-interface-def] - (analyse-jvm-interface analyse compile-interface =gclass-decl =supers =anns =methods))))) - - (if-let [[_ _def-code] (re-find #"^class:(.*)$" proc)] - (|do [[_module _line _column] &/cursor] - (&reader/with-source (str "class@" "(" _module "," _line "," _column ")") _def-code - (|do [[=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods] &&a-parser/parse-class-def] - (analyse-jvm-class analyse compile-class =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods))))) - - (if-let [[_ _def-code] (re-find #"^anon-class:(.*)$" proc)] - (|do [[_module _line _column] &/cursor] - (&reader/with-source (str "anon-class@" "(" _module "," _line "," _column ")") _def-code - (|do [[=super-class =interfaces =ctor-args =methods] &&a-parser/parse-anon-class-def] - (analyse-jvm-anon-class analyse compile-class exo-type =super-class =interfaces =ctor-args =methods))))) - - (if-let [[_ _class] (re-find #"^instanceof:([^:]+)$" proc)] - (analyse-jvm-instanceof analyse exo-type _class ?values)) - - (if-let [[_ _class _arg-classes] (re-find #"^new:([^:]+):([^:]*)$" proc)] - (analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) - - (if-let [[_ _class _method _arg-classes] (re-find #"^invokestatic:([^:]+):([^:]+):([^:]*)$" proc)] - (analyse-jvm-invokestatic analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) - - (if-let [[_ _class _method _arg-classes] (re-find #"^invokeinterface:([^:]+):([^:]+):([^:]*)$" proc)] - (analyse-jvm-invokeinterface analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) - - (if-let [[_ _class _method _arg-classes] (re-find #"^invokevirtual:([^:]+):([^:]+):([^:]*)$" proc)] - (analyse-jvm-invokevirtual analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) - - (if-let [[_ _class _method _arg-classes] (re-find #"^invokespecial:([^:]+):([^:]+):([^:]*)$" proc)] - (analyse-jvm-invokespecial analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) - - (if-let [[_ _class _field] (re-find #"^getstatic:([^:]+):([^:]+)$" proc)] - (analyse-jvm-getstatic analyse exo-type _class _field ?values)) - - (if-let [[_ _class _field] (re-find #"^getfield:([^:]+):([^:]+)$" proc)] - (analyse-jvm-getfield analyse exo-type _class _field ?values)) - - (if-let [[_ _class _field] (re-find #"^putstatic:([^:]+):([^:]+)$" proc)] - (analyse-jvm-putstatic analyse exo-type _class _field ?values)) - - (if-let [[_ _class _field] (re-find #"^putfield:([^:]+):([^:]+)$" proc)] - (analyse-jvm-putfield analyse exo-type _class _field ?values)))) + (try (case proc + "jvm synchronized" (analyse-jvm-synchronized analyse exo-type ?values) + "jvm load-class" (analyse-jvm-load-class analyse exo-type ?values) + "jvm throw" (analyse-jvm-throw analyse exo-type ?values) + "jvm null?" (analyse-jvm-null? analyse exo-type ?values) + "jvm null" (analyse-jvm-null analyse exo-type ?values) + "jvm anewarray" (analyse-jvm-anewarray analyse exo-type ?values) + "jvm aaload" (analyse-jvm-aaload analyse exo-type ?values) + "jvm aastore" (analyse-jvm-aastore analyse exo-type ?values) + "jvm arraylength" (analyse-jvm-arraylength analyse exo-type ?values) + "jvm znewarray" (analyse-jvm-znewarray analyse exo-type ?values) + "jvm bnewarray" (analyse-jvm-bnewarray analyse exo-type ?values) + "jvm snewarray" (analyse-jvm-snewarray analyse exo-type ?values) + "jvm inewarray" (analyse-jvm-inewarray analyse exo-type ?values) + "jvm lnewarray" (analyse-jvm-lnewarray analyse exo-type ?values) + "jvm fnewarray" (analyse-jvm-fnewarray analyse exo-type ?values) + "jvm dnewarray" (analyse-jvm-dnewarray analyse exo-type ?values) + "jvm cnewarray" (analyse-jvm-cnewarray analyse exo-type ?values) + "jvm zaload" (analyse-jvm-zaload analyse exo-type ?values) + "jvm zastore" (analyse-jvm-zastore analyse exo-type ?values) + "jvm baload" (analyse-jvm-baload analyse exo-type ?values) + "jvm bastore" (analyse-jvm-bastore analyse exo-type ?values) + "jvm saload" (analyse-jvm-saload analyse exo-type ?values) + "jvm sastore" (analyse-jvm-sastore analyse exo-type ?values) + "jvm iaload" (analyse-jvm-iaload analyse exo-type ?values) + "jvm iastore" (analyse-jvm-iastore analyse exo-type ?values) + "jvm laload" (analyse-jvm-laload analyse exo-type ?values) + "jvm lastore" (analyse-jvm-lastore analyse exo-type ?values) + "jvm faload" (analyse-jvm-faload analyse exo-type ?values) + "jvm fastore" (analyse-jvm-fastore analyse exo-type ?values) + "jvm daload" (analyse-jvm-daload analyse exo-type ?values) + "jvm dastore" (analyse-jvm-dastore analyse exo-type ?values) + "jvm caload" (analyse-jvm-caload analyse exo-type ?values) + "jvm castore" (analyse-jvm-castore analyse exo-type ?values) + "jvm iadd" (analyse-jvm-iadd analyse exo-type ?values) + "jvm isub" (analyse-jvm-isub analyse exo-type ?values) + "jvm imul" (analyse-jvm-imul analyse exo-type ?values) + "jvm idiv" (analyse-jvm-idiv analyse exo-type ?values) + "jvm irem" (analyse-jvm-irem analyse exo-type ?values) + "jvm ieq" (analyse-jvm-ieq analyse exo-type ?values) + "jvm ilt" (analyse-jvm-ilt analyse exo-type ?values) + "jvm igt" (analyse-jvm-igt analyse exo-type ?values) + "jvm ceq" (analyse-jvm-ceq analyse exo-type ?values) + "jvm clt" (analyse-jvm-clt analyse exo-type ?values) + "jvm cgt" (analyse-jvm-cgt analyse exo-type ?values) + "jvm ladd" (analyse-jvm-ladd analyse exo-type ?values) + "jvm lsub" (analyse-jvm-lsub analyse exo-type ?values) + "jvm lmul" (analyse-jvm-lmul analyse exo-type ?values) + "jvm ldiv" (analyse-jvm-ldiv analyse exo-type ?values) + "jvm lrem" (analyse-jvm-lrem analyse exo-type ?values) + "jvm leq" (analyse-jvm-leq analyse exo-type ?values) + "jvm llt" (analyse-jvm-llt analyse exo-type ?values) + "jvm lgt" (analyse-jvm-lgt analyse exo-type ?values) + "jvm fadd" (analyse-jvm-fadd analyse exo-type ?values) + "jvm fsub" (analyse-jvm-fsub analyse exo-type ?values) + "jvm fmul" (analyse-jvm-fmul analyse exo-type ?values) + "jvm fdiv" (analyse-jvm-fdiv analyse exo-type ?values) + "jvm frem" (analyse-jvm-frem analyse exo-type ?values) + "jvm feq" (analyse-jvm-feq analyse exo-type ?values) + "jvm flt" (analyse-jvm-flt analyse exo-type ?values) + "jvm fgt" (analyse-jvm-fgt analyse exo-type ?values) + "jvm dadd" (analyse-jvm-dadd analyse exo-type ?values) + "jvm dsub" (analyse-jvm-dsub analyse exo-type ?values) + "jvm dmul" (analyse-jvm-dmul analyse exo-type ?values) + "jvm ddiv" (analyse-jvm-ddiv analyse exo-type ?values) + "jvm drem" (analyse-jvm-drem analyse exo-type ?values) + "jvm deq" (analyse-jvm-deq analyse exo-type ?values) + "jvm dlt" (analyse-jvm-dlt analyse exo-type ?values) + "jvm dgt" (analyse-jvm-dgt analyse exo-type ?values) + "jvm iand" (analyse-jvm-iand analyse exo-type ?values) + "jvm ior" (analyse-jvm-ior analyse exo-type ?values) + "jvm ixor" (analyse-jvm-ixor analyse exo-type ?values) + "jvm ishl" (analyse-jvm-ishl analyse exo-type ?values) + "jvm ishr" (analyse-jvm-ishr analyse exo-type ?values) + "jvm iushr" (analyse-jvm-iushr analyse exo-type ?values) + "jvm land" (analyse-jvm-land analyse exo-type ?values) + "jvm lor" (analyse-jvm-lor analyse exo-type ?values) + "jvm lxor" (analyse-jvm-lxor analyse exo-type ?values) + "jvm lshl" (analyse-jvm-lshl analyse exo-type ?values) + "jvm lshr" (analyse-jvm-lshr analyse exo-type ?values) + "jvm lushr" (analyse-jvm-lushr analyse exo-type ?values) + "jvm d2f" (analyse-jvm-d2f analyse exo-type ?values) + "jvm d2i" (analyse-jvm-d2i analyse exo-type ?values) + "jvm d2l" (analyse-jvm-d2l analyse exo-type ?values) + "jvm f2d" (analyse-jvm-f2d analyse exo-type ?values) + "jvm f2i" (analyse-jvm-f2i analyse exo-type ?values) + "jvm f2l" (analyse-jvm-f2l analyse exo-type ?values) + "jvm i2b" (analyse-jvm-i2b analyse exo-type ?values) + "jvm i2c" (analyse-jvm-i2c analyse exo-type ?values) + "jvm i2d" (analyse-jvm-i2d analyse exo-type ?values) + "jvm i2f" (analyse-jvm-i2f analyse exo-type ?values) + "jvm i2l" (analyse-jvm-i2l analyse exo-type ?values) + "jvm i2s" (analyse-jvm-i2s analyse exo-type ?values) + "jvm l2d" (analyse-jvm-l2d analyse exo-type ?values) + "jvm l2f" (analyse-jvm-l2f analyse exo-type ?values) + "jvm l2i" (analyse-jvm-l2i analyse exo-type ?values) + "jvm l2s" (analyse-jvm-l2s analyse exo-type ?values) + "jvm l2b" (analyse-jvm-l2b analyse exo-type ?values) + "jvm c2b" (analyse-jvm-c2b analyse exo-type ?values) + "jvm c2s" (analyse-jvm-c2s analyse exo-type ?values) + "jvm c2i" (analyse-jvm-c2i analyse exo-type ?values) + "jvm c2l" (analyse-jvm-c2l analyse exo-type ?values) + "jvm b2l" (analyse-jvm-b2l analyse exo-type ?values) + "jvm s2l" (analyse-jvm-s2l analyse exo-type ?values) + ;; else + (->> (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " ["jvm" proc])) + (if-let [[_ _def-code] (re-find #"^jvm interface:(.*)$" proc)] + (|do [[_module _line _column] &/cursor] + (&reader/with-source (str "interface@" "(" _module "," _line "," _column ")") _def-code + (|do [[=gclass-decl =supers =anns =methods] &&a-parser/parse-interface-def] + (analyse-jvm-interface analyse compile-interface =gclass-decl =supers =anns =methods))))) + + (if-let [[_ _def-code] (re-find #"^jvm class:(.*)$" proc)] + (|do [[_module _line _column] &/cursor] + (&reader/with-source (str "class@" "(" _module "," _line "," _column ")") _def-code + (|do [[=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods] &&a-parser/parse-class-def] + (analyse-jvm-class analyse compile-class =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods))))) + + (if-let [[_ _def-code] (re-find #"^jvm anon-class:(.*)$" proc)] + (|do [[_module _line _column] &/cursor] + (&reader/with-source (str "anon-class@" "(" _module "," _line "," _column ")") _def-code + (|do [[=super-class =interfaces =ctor-args =methods] &&a-parser/parse-anon-class-def] + (analyse-jvm-anon-class analyse compile-class exo-type =super-class =interfaces =ctor-args =methods))))) + + (if-let [[_ _class] (re-find #"^jvm instanceof:([^:]+)$" proc)] + (analyse-jvm-instanceof analyse exo-type _class ?values)) + + (if-let [[_ _class _arg-classes] (re-find #"^jvm new:([^:]+):([^:]*)$" proc)] + (analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) + + (if-let [[_ _class _method _arg-classes] (re-find #"^jvm invokestatic:([^:]+):([^:]+):([^:]*)$" proc)] + (analyse-jvm-invokestatic analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) + + (if-let [[_ _class _method _arg-classes] (re-find #"^jvm invokeinterface:([^:]+):([^:]+):([^:]*)$" proc)] + (analyse-jvm-invokeinterface analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) + + (if-let [[_ _class _method _arg-classes] (re-find #"^jvm invokevirtual:([^:]+):([^:]+):([^:]*)$" proc)] + (analyse-jvm-invokevirtual analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) + + (if-let [[_ _class _method _arg-classes] (re-find #"^jvm invokespecial:([^:]+):([^:]+):([^:]*)$" proc)] + (analyse-jvm-invokespecial analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values)) + + (if-let [[_ _class _field] (re-find #"^jvm getstatic:([^:]+):([^:]+)$" proc)] + (analyse-jvm-getstatic analyse exo-type _class _field ?values)) + + (if-let [[_ _class _field] (re-find #"^jvm getfield:([^:]+):([^:]+)$" proc)] + (analyse-jvm-getfield analyse exo-type _class _field ?values)) + + (if-let [[_ _class _field] (re-find #"^jvm putstatic:([^:]+):([^:]+)$" proc)] + (analyse-jvm-putstatic analyse exo-type _class _field ?values)) + + (if-let [[_ _class _field] (re-find #"^jvm putfield:([^:]+):([^:]+)$" proc)] + (analyse-jvm-putfield analyse exo-type _class _field ?values)))) + (catch Exception ex + (&/fail-with-loc (str "[Analyser Error] Invalid syntax for procedure: " proc)))) )) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 51dff8142..c9a800741 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1096,7 +1096,7 @@ (def:'' (text/= x y) #;Nil (#Function Text (#Function Text Bool)) - (_lux_proc ["text" "="] [x y])) + ("lux text =" x y)) (def:'' (get-rep key env) #;Nil @@ -1158,7 +1158,7 @@ pairs)) [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] - (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil))) + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux nat +" +2 idx)) #Nil))) [_ (#Form members)] (form$ (map update-bounds members)) @@ -1209,7 +1209,7 @@ #;Nil (#UnivQ #Nil (#Function ($' List (#Bound +1)) Int)) - (fold (function'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list)) + (fold (function'' [_ acc] ("lux int +" 1 acc)) 0 list)) (macro:' #export (All tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1248,11 +1248,11 @@ body' [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] + (replace-syntax (#Cons [self-name (make-bound ("lux nat *" + +2 ("lux nat -" + ("lux int to-nat" + (length names)) + +1)))] #Nil) body')}) #Nil))))) @@ -1300,11 +1300,10 @@ body' [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] + (replace-syntax (#Cons [self-name (make-bound ("lux nat *" + +2 ("lux nat -" + ("lux int to-nat" (length names)) + +1)))] #Nil) body')}) #Nil))))) @@ -1765,12 +1764,12 @@ Useful for debugging.")]) (-> Text Unit) - (_lux_proc ["io" "log"] [message])) + ("lux io log" message)) (def:''' (text/compose x y) #Nil (-> Text Text Text) - (_lux_proc ["text" "append"] [x y])) + ("lux text append" x y)) (def:''' (ident/encode ident) #Nil @@ -2197,7 +2196,7 @@ (let' [apply ("lux check" (-> RepEnv ($' List Code)) (function' [env] (map (apply-template env) templates))) num-bindings (length bindings')] - (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample])) + (if (every? (function' [sample] ("lux int =" num-bindings sample)) (map length data')) (|> data' (join-map (. apply (make-env bindings'))) @@ -2210,47 +2209,48 @@ _ (fail "Wrong syntax for do-template")})) -(do-template [ <=-name> +(do-template [ + <=-proc> <=-name> <<-doc> <<=-doc> <>-doc> <>=-doc>] [(def:''' #export (<=-name> test subject) (list [(tag$ ["lux" "doc"]) (text$ )]) (-> Bool) - (_lux_proc [ "="] [subject test])) + (<=-proc> subject test)) (def:''' #export ( test subject) (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)]) (-> Bool) - (_lux_proc [ "<"] [subject test])) + ( subject test)) (def:''' #export ( test subject) (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)]) (-> Bool) - (if (_lux_proc [ "<"] [subject test]) + (if ( subject test) true - (_lux_proc [ "="] [subject test]))) + (<=-proc> subject test))) (def:''' #export ( test subject) (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)]) (-> Bool) - (_lux_proc [ "<"] [test subject])) + ( test subject)) (def:''' #export ( test subject) (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)]) (-> Bool) - (if (_lux_proc [ "<"] [test subject]) + (if ( test subject) true - (_lux_proc [ "="] [subject test])))] + (<=-proc> subject test)))] - [ Nat "nat" n.= n.< n.<= n.> n.>= + [ Nat "lux nat =" "lux nat <" n.= n.< n.<= n.> n.>= "Nat(ural) equality." "Nat(ural) less-than." "Nat(ural) less-than-equal." "Nat(ural) greater-than." "Nat(ural) greater-than-equal."] - [ Int "int" i.= i.< i.<= i.> i.>= + [ Int "lux int =" "lux int <" i.= i.< i.<= i.> i.>= "Int(eger) equality." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."] - [ Deg "deg" d.= d.< d.<= d.> d.>= + [ Deg "lux deg =" "lux deg <" d.= d.< d.<= d.> d.>= "Deg(ree) equality." "Deg(ree) less-than." "Deg(ree) less-than-equal." "Deg(ree) greater-than." "Deg(ree) greater-than-equal."] - [Frac "frac" f.= f.< f.<= f.> f.>= + [Frac "lux frac =" "lux frac <" f.= f.< f.<= f.> f.>= "Frac(tion) equality." "Frac(tion) less-than." "Frac(tion) less-than-equal." "Frac(tion) greater-than." "Frac(tion) greater-than-equal."] ) @@ -2258,41 +2258,41 @@ [(def:''' #export ( param subject) (list [(tag$ ["lux" "doc"]) (text$ )]) (-> ) - (_lux_proc [subject param]))] + ( subject param))] - [ Nat n.+ [ "nat" "+"] "Nat(ural) addition."] - [ Nat n.- [ "nat" "-"] "Nat(ural) substraction."] - [ Nat n.* [ "nat" "*"] "Nat(ural) multiplication."] - [ Nat n./ [ "nat" "/"] "Nat(ural) division."] - [ Nat n.% [ "nat" "%"] "Nat(ural) remainder."] + [ Nat n.+ "lux nat +" "Nat(ural) addition."] + [ Nat n.- "lux nat -" "Nat(ural) substraction."] + [ Nat n.* "lux nat *" "Nat(ural) multiplication."] + [ Nat n./ "lux nat /" "Nat(ural) division."] + [ Nat n.% "lux nat %" "Nat(ural) remainder."] - [ Int i.+ [ "int" "+"] "Int(eger) addition."] - [ Int i.- [ "int" "-"] "Int(eger) substraction."] - [ Int i.* [ "int" "*"] "Int(eger) multiplication."] - [ Int i./ [ "int" "/"] "Int(eger) division."] - [ Int i.% [ "int" "%"] "Int(eger) remainder."] - - [ Deg d.+ [ "deg" "+"] "Deg(ree) addition."] - [ Deg d.- [ "deg" "-"] "Deg(ree) substraction."] - [ Deg d.* [ "deg" "*"] "Deg(ree) multiplication."] - [ Deg d./ [ "deg" "/"] "Deg(ree) division."] - [ Deg d.% [ "deg" "%"] "Deg(ree) remainder."] + [ Int i.+ "lux int +" "Int(eger) addition."] + [ Int i.- "lux int -" "Int(eger) substraction."] + [ Int i.* "lux int *" "Int(eger) multiplication."] + [ Int i./ "lux int /" "Int(eger) division."] + [ Int i.% "lux int %" "Int(eger) remainder."] + + [ Deg d.+ "lux deg +" "Deg(ree) addition."] + [ Deg d.- "lux deg -" "Deg(ree) substraction."] + [ Deg d.* "lux deg *" "Deg(ree) multiplication."] + [ Deg d./ "lux deg /" "Deg(ree) division."] + [ Deg d.% "lux deg %" "Deg(ree) remainder."] - [Frac f.+ ["frac" "+"] "Frac(tion) addition."] - [Frac f.- ["frac" "-"] "Frac(tion) substraction."] - [Frac f.* ["frac" "*"] "Frac(tion) multiplication."] - [Frac f./ ["frac" "/"] "Frac(tion) division."] - [Frac f.% ["frac" "%"] "Frac(tion) remainder."] + [Frac f.+ "lux frac +" "Frac(tion) addition."] + [Frac f.- "lux frac -" "Frac(tion) substraction."] + [Frac f.* "lux frac *" "Frac(tion) multiplication."] + [Frac f./ "lux frac /" "Frac(tion) division."] + [Frac f.% "lux frac %" "Frac(tion) remainder."] ) (do-template [ ] [(def:''' #export ( param subject) (list [(tag$ ["lux" "doc"]) (text$ )]) (-> Nat ) - (_lux_proc [subject param]))] + ( subject param))] - [ Deg d.scale [ "deg" "scale"] "Deg(ree) scale."] - [ Deg d.reciprocal [ "deg" "reciprocal"] "Deg(ree) reciprocal."] + [ Deg d.scale "lux deg scale" "Deg(ree) scale."] + [ Deg d.reciprocal "lux deg reciprocal" "Deg(ree) reciprocal."] ) (do-template [ ] @@ -2329,7 +2329,7 @@ +1 "1" +2 "2" +3 "3" +4 "4" +5 "5" +6 "6" +7 "7" +8 "8" +9 "9" - _ (_lux_proc ["io" "error"] ["undefined"])})) + _ ("lux io error" "undefined")})) (def:''' (nat/encode value) #Nil @@ -2341,11 +2341,11 @@ _ (let' [loop ("lux check" (-> Nat Text Text) (function' recur [input output] - (if (_lux_proc ["nat" "="] [input +0]) - (_lux_proc ["text" "append"] ["+" output]) - (recur (_lux_proc ["nat" "/"] [input +10]) - (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) - output])))))] + (if ("lux nat =" input +0) + ("lux text append" "+" output) + (recur ("lux nat /" input +10) + ("lux text append" (digit-to-text ("lux nat %" input +10)) + output)))))] (loop value ""))})) (def:''' (int/abs value) @@ -2366,17 +2366,17 @@ (("lux check" (-> Int Text Text) (function' recur [input output] (if (i.= 0 input) - (_lux_proc ["text" "append"] [sign output]) + ("lux text append" sign output) (recur (i./ 10 input) - (_lux_proc ["text" "append"] [(|> input (i.% 10) ("lux coerce" Nat) digit-to-text) - output]))))) + ("lux text append" (|> input (i.% 10) ("lux coerce" Nat) digit-to-text) + output))))) (|> value (i./ 10) int/abs) (|> value (i.% 10) int/abs ("lux coerce" Nat) digit-to-text))))) (def:''' (frac/encode x) #Nil (-> Frac Text) - (_lux_proc ["frac" "encode"] [x])) + ("lux frac encode" x)) (def:''' (multiple? div n) #Nil @@ -2812,7 +2812,7 @@ (int/encode value) [_ (#Deg value)] - (_lux_proc ["io" "error"] ["Undefined behavior."]) + ("lux io error" "Undefined behavior.") [_ (#Frac value)] (frac/encode value) @@ -3358,25 +3358,25 @@ (do-template [ ] [(def: ( part text) (-> Text Text (Maybe Nat)) - (_lux_proc ["text" ] [text part ]))] + ( text part ))] - [index-of "index" +0] - [last-index-of "last-index" (_lux_proc ["text" "size"] [text])] + [index-of "lux text index" +0] + [last-index-of "lux text last-index" ("lux text size" text)] ) (def: (clip1 from text) (-> Nat Text (Maybe Text)) - (_lux_proc ["text" "clip"] [text from (_lux_proc ["text" "size"] [text])])) + ("lux text clip" text from ("lux text size" text))) (def: (clip2 from to text) (-> Nat Nat Text (Maybe Text)) - (_lux_proc ["text" "clip"] [text from to])) + ("lux text clip" text from to)) (def: #export (error! message) {#;doc "## Causes an error, with the given error message. (error! \"OH NO!\")"} (-> Text Bottom) - (_lux_proc ["io" "error"] [message])) + ("lux io error" message)) (macro: (default tokens state) {#;doc "## Allows you to provide a default value that will be used @@ -3478,7 +3478,7 @@ (#Function (beta-reduce env ?input) (beta-reduce env ?output)) (#Bound idx) - (case (nth (_lux_proc ["nat" "to-int"] [idx]) env) + (case (nth ("lux nat to-int" idx) env) (#Some bound) bound @@ -4059,7 +4059,7 @@ (def: (replace-all pattern value template) (-> Text Text Text Text) - (_lux_proc ["text" "replace-all"] [template pattern value])) + ("lux text replace-all" template pattern value)) (def: (clean-module module) (-> Text (Meta Text)) @@ -4989,10 +4989,10 @@ (do-template [ ] [(def: #export ( n) (-> ) - (_lux_proc [n]))] + ( [n]))] - [frac-to-int Frac Int ["frac" "to-int"]] - [int-to-frac Int Frac ["int" "to-frac"]] + [frac-to-int Frac Int "lux frac to-int"] + [int-to-frac Int Frac "lux int to-frac"] ) (def: (find-baseline-column code) @@ -5068,12 +5068,12 @@ (do-template [ ] [(def: #export ( input) (-> ) - (_lux_proc [input]))] + ( input))] - [int-to-nat ["int" "to-nat"] Int Nat] - [nat-to-int ["nat" "to-int"] Nat Int] - [frac-to-deg ["frac" "to-deg"] Frac Deg] - [deg-to-frac ["deg" "to-frac"] Deg Frac] + [int-to-nat "lux int to-nat" Int Nat] + [nat-to-int "lux nat to-int" Nat Int] + [frac-to-deg "lux frac to-deg" Frac Deg] + [deg-to-frac "lux deg to-frac" Deg Frac] ) (def: (repeat n x) @@ -5092,11 +5092,11 @@ (def: (text/size x) (-> Text Nat) - (_lux_proc ["text" "size"] [x])) + ("lux text size" x)) (def: (text/trim x) (-> Text Text) - (_lux_proc ["text" "trim"] [x])) + ("lux text trim" x)) (def: (update-cursor [file line column] code-text) (-> Cursor Text Cursor) @@ -5144,7 +5144,7 @@ [#Record "{" "}" rejoin-all-pairs]) [new-cursor (#Deg value)] - (_lux_proc ["io" "error"] ["Undefined behavior."]) + ("lux io error" "Undefined behavior.") )) (def: (with-baseline baseline [file line column]) @@ -5663,7 +5663,7 @@ "This one should fail:" (is 5 (i.+ 2 3)))} (All [a] (-> a a Bool)) - (_lux_proc ["lux" "is"] [reference sample])) + ("lux is" reference sample)) (macro: #export (^@ tokens) {#;doc (doc "Allows you to simultaneously bind and de-structure a value." @@ -5858,8 +5858,8 @@ (macro: #export (char tokens compiler) (case tokens (^multi (^ (list [_ (#Text input)])) - (n.= +1 (_lux_proc ["text" "size"] [input]))) - (|> (_lux_proc ["text" "char"] [input +0]) + (n.= +1 ("lux text size" input))) + (|> ("lux text char" input +0) (default (undefined)) nat$ list [compiler] #;Right) diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index aad81a791..1260c758f 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -9,18 +9,18 @@ (def: #export (atom value) (All [a] (-> a (Atom a))) - (_lux_proc ["atom" "new"] [value])) + ("lux atom new" value)) (def: #export (get atom) (All [a] (-> (Atom a) (IO a))) - (io (_lux_proc ["atom" "get"] [atom]))) + (io ("lux atom get" atom))) (def: #export (compare-and-swap current new atom) {#;doc "Only mutates an atom if you can present it's current value. That guarantees that atom was not updated since you last read from it."} (All [a] (-> a a (Atom a) (IO Bool))) - (io (_lux_proc ["atom" "compare-and-swap"] [atom current new]))) + (io ("lux atom compare-and-swap" atom current new))) (def: #export (update f atom) {#;doc "Updates an atom by applying a function to its current value. @@ -29,8 +29,8 @@ The retries will be done with the new values of the atom, as they show up."} (All [a] (-> (-> a a) (Atom a) (IO Unit))) - (io (let [old (_lux_proc ["atom" "get"] [atom])] - (if (_lux_proc ["atom" "compare-and-swap"] [atom old (f old)]) + (io (let [old ("lux atom get" atom)] + (if ("lux atom compare-and-swap" atom old (f old)) [] (io;run (update f atom)))))) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index b41a20e41..63cd88c77 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -16,7 +16,7 @@ (def: #export concurrency-level Nat - (_lux_proc ["process" "concurrency-level"] [])) + ("lux process concurrency-level")) (type: (Promise-State a) {#value (Maybe a) @@ -176,15 +176,15 @@ {#;doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."} (All [a] (-> (IO a) (Promise a))) (let [!out (promise ($ +0))] - (exec (_lux_proc ["process" "future"] [(io (io;run (resolve (io;run computation) - !out)))]) + (exec ("lux process future" (io (io;run (resolve (io;run computation) + !out)))) !out))) (def: #export (wait time) {#;doc "Returns a Promise that will be resolved after the specified amount of milliseconds."} (-> Nat (Promise Unit)) (let [!out (promise Unit)] - (exec (_lux_proc ["process" "schedule"] [time (resolve [] !out)]) + (exec ("lux process schedule" time (resolve [] !out)) !out))) (def: #export (time-out time promise) diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index ebee21f3c..ee4dc4449 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -7,20 +7,20 @@ [(def: #export ( param subject) {#;doc } (-> Nat ) - (_lux_proc ["bit" ] [subject param]))] - - [and "and" "Bitwise and." Nat] - [or "or" "Bitwise or." Nat] - [xor "xor" "Bitwise xor." Nat] - [shift-left "shift-left" "Bitwise shift-left." Nat] - [shift-right "unsigned-shift-right" "Unsigned bitwise shift-right." Nat] - [signed-shift-right "shift-right" "Signed bitwise shift-right." Int] + ( subject param))] + + [and "lux bit and" "Bitwise and." Nat] + [or "lux bit or" "Bitwise or." Nat] + [xor "lux bit xor" "Bitwise xor." Nat] + [shift-left "lux bit shift-left" "Bitwise shift-left." Nat] + [shift-right "lux bit unsigned-shift-right" "Unsigned bitwise shift-right." Nat] + [signed-shift-right "lux bit shift-right" "Signed bitwise shift-right." Int] ) (def: #export (count subject) {#;doc "Count the number of 1s in a bit-map."} (-> Nat Nat) - (_lux_proc ["bit" "count"] [subject])) + ("lux bit count" subject)) (def: #export not {#;doc "Bitwise negation."} diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index a4a3aa903..2dbf07803 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -10,26 +10,26 @@ (def: #export (new size) (All [a] (-> Nat (Array a))) - (_lux_proc ["array" "new"] [size])) + ("lux array new" size)) (def: #export (size xs) (All [a] (-> (Array a) Nat)) - (_lux_proc ["array" "size"] [xs])) + ("lux array size" xs)) (def: #export (read i xs) (All [a] (-> Nat (Array a) (Maybe a))) - (_lux_proc ["array" "get"] [xs i])) + ("lux array get" xs i)) (def: #export (write i x xs) (All [a] (-> Nat a (Array a) (Array a))) - (_lux_proc ["array" "put"] [xs i x])) + ("lux array put" xs i x)) (def: #export (delete i xs) (All [a] (-> Nat (Array a) (Array a))) - (_lux_proc ["array" "remove"] [xs i])) + ("lux array remove" xs i)) (def: #export (copy length src-start src-array dest-start dest-array) (All [a] (-> Nat Nat (Array a) Nat (Array a) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index cab5479be..efdb727a5 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -368,7 +368,7 @@ (map (function [idx] (let [base (Nat/encode idx)] [(symbol$ base) - (symbol$ (_lux_proc ["text" "append"] [base "'"]))])))) + (symbol$ ("lux text append" base "'"))])))) pattern (` [(~@ (map (function [[v vs]] (` (#;Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") @@ -415,7 +415,7 @@ (map (function [idx] (let [base (Nat/encode idx)] [(symbol$ base) - (symbol$ (_lux_proc ["text" "append"] [base "'"]))])))) + (symbol$ ("lux text append" base "'"))])))) pattern (` [(~@ (map (function [[v vs]] (` (#;Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux index 5a79ccd0a..879ace1e6 100644 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ b/stdlib/source/lux/data/coll/priority-queue.lux @@ -11,8 +11,8 @@ (type: #export (Queue a) (Maybe (F;Fingers Priority a))) -(def: max-priority Priority (_lux_proc [ "nat" "max-value"] [])) -(def: min-priority Priority (_lux_proc [ "nat" "min-value"] [])) +(def: max-priority Priority ("lux nat max-value")) +(def: min-priority Priority ("lux nat min-value")) (def: #export empty Queue diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 729c83979..4dc0e4685 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -80,10 +80,10 @@ (def: * d.*) (def: / d./) (def: % d.%) - (def: (negate x) (d.- x (_lux_proc ["deg" "max-value"] []))) + (def: (negate x) (d.- x ("lux deg max-value"))) (def: abs id) (def: (signum x) - (_lux_proc ["deg" "max-value"] [])) + ("lux deg max-value")) ) (do-template [ ] @@ -94,8 +94,8 @@ [Nat Order n.inc n.dec] [Int Order i.inc i.dec] - [Frac Order (f.+ (_lux_proc [ "frac" "smallest-value"] [])) (f.- (_lux_proc [ "frac" "smallest-value"] []))] - [Deg Order (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))] + [Frac Order (f.+ ("lux frac smallest-value")) (f.- ("lux frac smallest-value"))] + [Deg Order (d.+ ("lux deg min-value")) (d.- ("lux deg min-value"))] ) (do-template [ ] @@ -104,10 +104,10 @@ (def: top ) (def: bottom ))] - [ Nat Enum (_lux_proc [ "nat" "max-value"] []) (_lux_proc [ "nat" "min-value"] [])] - [ Int Enum (_lux_proc [ "int" "max-value"] []) (_lux_proc [ "int" "min-value"] [])] - [Frac Enum (_lux_proc ["frac" "max-value"] []) (_lux_proc ["frac" "min-value"] [])] - [ Deg Enum (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])] + [ Nat Enum ("lux nat max-value") ("lux nat min-value")] + [ Int Enum ("lux int max-value") ("lux int min-value")] + [Frac Enum ("lux frac max-value") ("lux frac min-value")] + [ Deg Enum ("lux deg max-value") ("lux deg min-value")] ) (do-template [ ] @@ -137,11 +137,11 @@ [(def: #export {#;doc } Frac - (_lux_proc ["frac" ] []))] + ())] - [not-a-number "not-a-number" "Not-a-number."] - [positive-infinity "positive-infinity" "Positive infinity."] - [negative-infinity "negative-infinity" "Negative infinity."] + [not-a-number "lux frac not-a-number" "Not-a-number."] + [positive-infinity "lux frac positive-infinity" "Positive infinity."] + [negative-infinity "lux frac negative-infinity" "Negative infinity."] ) (def: #export (not-a-number? number) @@ -158,23 +158,23 @@ (do-template [ ] [(struct: #export _ (Codec Text ) (def: (encode x) - (_lux_proc [x])) + ( [x])) (def: (decode input) - (case (_lux_proc [input]) + (case ( [input]) (#;Some value) (#E;Success value) #;None (#E;Error ))))] - [Frac ["frac" "encode"] ["frac" "decode"] "Could not decode Frac"] + [Frac "lux frac encode" "lux frac decode" "Could not decode Frac"] ) ## [Values & Syntax] (def: (get-char full idx) (-> Text Nat (Maybe Text)) - (_lux_proc ["text" "clip"] [full idx (n.inc idx)])) + ("lux text clip" full idx (n.inc idx))) (do-template [ ] [(struct: #export (Codec Text Nat) @@ -182,25 +182,25 @@ (loop [input value output ""] (let [digit (maybe;assume (get-char (n.% input))) - output' (_lux_proc ["text" "append"] [digit output]) + output' ("lux text append" digit output) input' (n./ input)] (if (n.= +0 input') - (_lux_proc ["text" "append"] ["+" output']) + ("lux text append" "+" output') (recur input' output'))))) (def: (decode repr) - (let [input-size (_lux_proc ["text" "size"] [repr])] + (let [input-size ("lux text size" repr)] (if (n.>= +2 input-size) - (case (_lux_proc ["text" "char"] [repr +0]) + (case ("lux text char" repr +0) (^ (#;Some (char "+"))) - (let [input (_lux_proc ["text" "upper-case"] [repr])] + (let [input ("lux text upper-case" repr)] (loop [idx +1 output +0] (if (n.< input-size idx) (let [digit (maybe;assume (get-char input idx))] - (case (_lux_proc ["text" "index"] [ digit +0]) + (case ("lux text index" digit +0) #;None - (#E;Error (_lux_proc ["text" "append"] [ repr])) + (#E;Error ("lux text append" repr)) (#;Some index) (recur (n.inc idx) @@ -208,8 +208,8 @@ (#E;Success output)))) _ - (#E;Error (_lux_proc ["text" "append"] [ repr]))) - (#E;Error (_lux_proc ["text" "append"] [ repr]))))))] + (#E;Error ("lux text append" repr))) + (#E;Error ("lux text append" repr))))))] [Binary@Codec +2 "01" "Invalid binary syntax for Nat: "] [Octal@Codec +8 "01234567" "Invalid octal syntax for Nat: "] @@ -230,13 +230,13 @@ (get-char ) maybe;assume)] (if (i.= 0 input) - (_lux_proc ["text" "append"] [sign output]) + ("lux text append" sign output) (let [digit (maybe;assume (get-char (int-to-nat (i.% input))))] (recur (i./ input) - (_lux_proc ["text" "append"] [digit output])))))))) + ("lux text append" digit output)))))))) (def: (decode repr) - (let [input-size (_lux_proc ["text" "size"] [repr])] + (let [input-size ("lux text size" repr)] (if (n.>= +1 input-size) (let [sign (case (get-char repr +0) (^ (#;Some "-")) @@ -244,12 +244,12 @@ _ 1) - input (_lux_proc ["text" "upper-case"] [repr])] + input ("lux text upper-case" repr)] (loop [idx (if (i.= -1 sign) +1 +0) output 0] (if (n.< input-size idx) (let [digit (maybe;assume (get-char input idx))] - (case (_lux_proc ["text" "index"] [ digit +0]) + (case ("lux text index" digit +0) #;None (#E;Error ) @@ -267,35 +267,35 @@ (def: (de-prefix input) (-> Text Text) - (maybe;assume (_lux_proc ["text" "clip"] [input +1 (_lux_proc ["text" "size"] [input])]))) + (maybe;assume ("lux text clip" input +1 ("lux text size" input)))) (do-template [ ] [(struct: #export (Codec Text Deg) (def: (encode value) (let [raw-output (de-prefix (:: encode (:! Nat value))) max-num-chars (n./ +64) - raw-size (_lux_proc ["text" "size"] [raw-output]) + raw-size ("lux text size" raw-output) zero-padding (loop [zeroes-left (n.- raw-size max-num-chars) output ""] (if (n.= +0 zeroes-left) output (recur (n.dec zeroes-left) - (_lux_proc ["text" "append"] ["0" output])))) - padded-output (_lux_proc ["text" "append"] [zero-padding raw-output])] - (_lux_proc ["text" "append"] ["." padded-output]))) + ("lux text append" "0" output)))) + padded-output ("lux text append" zero-padding raw-output)] + ("lux text append" "." padded-output))) (def: (decode repr) - (let [repr-size (_lux_proc ["text" "size"] [repr])] + (let [repr-size ("lux text size" repr)] (if (n.>= +2 repr-size) - (case (_lux_proc ["text" "char"] [repr +0]) + (case ("lux text char" repr +0) (^multi (^ (#;Some (char "."))) - [(:: decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)])) + [(:: decode ("lux text append" "+" (de-prefix repr))) (#;Some output)]) (#E;Success (:! Deg output)) _ - (#E;Error (_lux_proc ["text" "append"] [ repr]))) - (#E;Error (_lux_proc ["text" "append"] [ repr]))))))] + (#E;Error ("lux text append" repr))) + (#E;Error ("lux text append" repr))))))] [Binary@Codec Binary@Codec +1 "Invalid binary syntax: "] [Octal@Codec Octal@Codec +3 "Invalid octal syntax: "] @@ -313,19 +313,19 @@ (loop [dec-left decimal output ""] (if (f.= 0.0 dec-left) - (_lux_proc ["text" "append"] ["." output]) + ("lux text append" "." output) (let [shifted (f.* dec-left) digit (|> shifted (f.% ) frac-to-int int-to-nat (get-char ) maybe;assume)] (recur (f.% 1.0 shifted) - (_lux_proc ["text" "append"] [output digit]))))))] - (_lux_proc ["text" "append"] [whole-part decimal-part]))) + ("lux text append" output digit))))))] + ("lux text append" whole-part decimal-part))) (def: (decode repr) - (case (_lux_proc ["text" "index"] [repr "." +0]) + (case ("lux text index" repr "." +0) (#;Some split-index) - (let [whole-part (maybe;assume (_lux_proc ["text" "clip"] [repr +0 split-index])) - decimal-part (maybe;assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])]))] + (let [whole-part (maybe;assume ("lux text clip" repr +0 split-index)) + decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr)))] (case [(:: decode whole-part) (:: decode decimal-part)] (^multi [(#;Some whole) (#;Some decimal)] @@ -333,14 +333,14 @@ (let [sign (if (i.< 0 whole) -1.0 1.0) - div-power (loop [muls-left (_lux_proc ["text" "size"] [decimal-part]) + div-power (loop [muls-left ("lux text size" decimal-part) output 1.0] (if (n.= +0 muls-left) output (recur (n.dec muls-left) (f.* output)))) adjusted-decimal (|> decimal int-to-frac (f./ div-power)) - dec-deg (case (:: Hex@Codec decode (_lux_proc ["text" "append"] ["." decimal-part])) + dec-deg (case (:: Hex@Codec decode ("lux text append" "." decimal-part)) (#E;Success dec-deg) dec-deg @@ -350,10 +350,10 @@ (f.* sign adjusted-decimal)))) _ - (#E;Error (_lux_proc ["text" "append"] [ repr])))) + (#E;Error ("lux text append" repr)))) _ - (#E;Error (_lux_proc ["text" "append"] [ repr])))))] + (#E;Error ("lux text append" repr)))))] [Binary@Codec Binary@Codec 2.0 "01" "Invalid binary syntax: "] ) @@ -365,12 +365,12 @@ (list) _ - (let [num-digits (_lux_proc ["text" "size"] [digits])] + (let [num-digits ("lux text size" digits)] (if (n.<= chunk-size num-digits) (list digits) (let [boundary (n.- chunk-size num-digits) - chunk (maybe;assume (_lux_proc ["text" "clip"] [digits boundary num-digits])) - remaining (maybe;assume (_lux_proc ["text" "clip"] [digits +0 boundary]))] + chunk (maybe;assume ("lux text clip" digits boundary num-digits)) + remaining (maybe;assume ("lux text clip" digits +0 boundary))] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -457,13 +457,13 @@ "" (#;Cons x xs') - (_lux_proc ["text" "append"] [x (re-join-chunks xs')]))) + ("lux text append" x (re-join-chunks xs')))) (do-template [ ] [(def: ( on-left? input) (-> Bool Text Text) (let [max-num-chars (n./ +64) - input-size (_lux_proc ["text" "size"] [input]) + input-size ("lux text size" input) zero-padding (let [num-digits-that-need-padding (n.% input-size)] (if (n.= +0 num-digits-that-need-padding) "" @@ -473,10 +473,10 @@ (if (n.= +0 zeroes-left) output (recur (n.dec zeroes-left) - (_lux_proc ["text" "append"] ["0" output])))))) + ("lux text append" "0" output)))))) padded-input (if on-left? - (_lux_proc ["text" "append"] [zero-padding input]) - (_lux_proc ["text" "append"] [input zero-padding]))] + ("lux text append" zero-padding input) + ("lux text append" input zero-padding))] (|> padded-input (segment-digits ) (map ) @@ -498,47 +498,41 @@ (def: (encode value) (let [sign (:: Number signum value) raw-bin (:: Binary@Codec encode value) - dot-idx (maybe;assume (_lux_proc ["text" "index"] [raw-bin "." +0])) - whole-part (maybe;assume (_lux_proc ["text" "clip"] [raw-bin - (if (f.= -1.0 sign) +1 +0) - dot-idx])) - decimal-part (maybe;assume (_lux_proc ["text" "clip"] [raw-bin (n.inc dot-idx) (_lux_proc ["text" "size"] [raw-bin])])) + dot-idx (maybe;assume ("lux text index" raw-bin "." +0)) + whole-part (maybe;assume ("lux text clip" raw-bin + (if (f.= -1.0 sign) +1 +0) + dot-idx)) + decimal-part (maybe;assume ("lux text clip" raw-bin (n.inc dot-idx) ("lux text size" raw-bin))) hex-output (|> ( false decimal-part) - ["."] - (_lux_proc ["text" "append"]) - [( true whole-part)] - (_lux_proc ["text" "append"]) - [(if (f.= -1.0 sign) "-" "")] - (_lux_proc ["text" "append"]))] + ("lux text append" ".") + ("lux text append" ( true whole-part)) + ("lux text append" (if (f.= -1.0 sign) "-" "")))] hex-output)) (def: (decode repr) - (let [sign (case (_lux_proc ["text" "index"] [repr "-" +0]) + (let [sign (case ("lux text index" repr "-" +0) (#;Some +0) -1.0 _ 1.0)] - (case (_lux_proc ["text" "index"] [repr "." +0]) + (case ("lux text index" repr "." +0) (#;Some split-index) - (let [whole-part (maybe;assume (_lux_proc ["text" "clip"] [repr (if (f.= -1.0 sign) +1 +0) split-index])) - decimal-part (maybe;assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])])) + (let [whole-part (maybe;assume ("lux text clip" repr (if (f.= -1.0 sign) +1 +0) split-index)) + decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr))) as-binary (|> ( decimal-part) - ["."] - (_lux_proc ["text" "append"]) - [( whole-part)] - (_lux_proc ["text" "append"]) - [(if (f.= -1.0 sign) "-" "")] - (_lux_proc ["text" "append"]))] + ("lux text append" ".") + ("lux text append" ( whole-part)) + ("lux text append" (if (f.= -1.0 sign) "-" "")))] (case (:: Binary@Codec decode as-binary) (#E;Error _) - (#E;Error (_lux_proc ["text" "append"] [ repr])) + (#E;Error ("lux text append" repr)) output output)) _ - (#E;Error (_lux_proc ["text" "append"] [ repr]))))))] + (#E;Error ("lux text append" repr))))))] [Octal@Codec "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary] [Hex@Codec "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary] @@ -599,19 +593,19 @@ (def: (make-digits _) (-> Top Digits) - (_lux_proc ["array" "new"] [bit;width])) + ("lux array new" bit;width)) (def: (digits-get idx digits) (-> Nat Digits Nat) - (maybe;default +0 (_lux_proc ["array" "get"] [digits idx]))) + (maybe;default +0 ("lux array get" digits idx))) (def: (digits-put idx digit digits) (-> Nat Nat Digits Digits) - (_lux_proc ["array" "put"] [digits idx digit])) + ("lux array put" digits idx digit)) (def: (prepend left right) (-> Text Text Text) - (_lux_proc ["text" "append"] [left right])) + ("lux text append" left right)) (def: (digits-times-5! idx output) (-> Nat Digits Digits) @@ -649,9 +643,9 @@ (recur (n.dec idx) true output) (recur (n.dec idx) false - (_lux_proc ["text" "append"] - [(:: Codec encode (:! Int digit)) - output])))) + ("lux text append" + (:: Codec encode (:! Int digit)) + output)))) (if all-zeroes? "0" output)))) @@ -673,13 +667,13 @@ (def: (text-to-digits input) (-> Text (Maybe Digits)) - (let [length (_lux_proc ["text" "size"] [input])] + (let [length ("lux text size" input)] (if (n.<= bit;width length) (loop [idx +0 output (make-digits [])] (if (n.< length idx) (let [char (maybe;assume (get-char input idx))] - (case (_lux_proc ["text" "index"] ["0123456789" char +0]) + (case ("lux text index" "0123456789" char +0) #;None #;None @@ -736,12 +730,12 @@ digits')) (recur (n.dec idx) digits)) - (_lux_proc ["text" "append"] ["." (digits-to-text digits)]) + ("lux text append" "." (digits-to-text digits)) ))))) (def: (decode input) - (let [length (_lux_proc ["text" "size"] [input]) - dotted? (case (_lux_proc ["text" "index"] [input "." +0]) + (let [length ("lux text size" input) + dotted? (case ("lux text index" input "." +0) (#;Some +0) true @@ -749,7 +743,7 @@ false)] (if (and dotted? (n.<= (n.inc bit;width) length)) - (case (|> (_lux_proc ["text" "clip"] [input +1 length]) + (case (|> ("lux text clip" input +1 length) maybe;assume text-to-digits) (#;Some digits) @@ -767,14 +761,14 @@ (#E;Success (:! Deg output)))) #;None - (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))) - (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input])))) + (#E;Error ("lux text append" "Wrong syntax for Deg: " input))) + (#E;Error ("lux text append" "Wrong syntax for Deg: " input)))) )) (def: (log2 input) (-> Frac Frac) - (f./ (_lux_proc ["math" "log"] [2.0]) - (_lux_proc ["math" "log"] [input]))) + (f./ ("lux math log" 2.0) + ("lux math log" input))) (def: double-bias Nat +1023) @@ -803,13 +797,13 @@ ## else (let [sign (:: Number signum input) input (:: Number abs input) - exponent (_lux_proc ["math" "floor"] [(log2 input)]) + exponent ("lux math floor" (log2 input)) exponent-mask (|> +1 (bit;shift-left exponent-size) n.dec) mantissa (|> input ## Normalize - (f./ (_lux_proc ["math" "pow"] [2.0 exponent])) + (f./ ("lux math pow" 2.0 exponent)) ## Make it int-equivalent - (f.* (_lux_proc ["math" "pow"] [2.0 52.0]))) + (f.* ("lux math pow" 2.0 52.0))) sign-bit (if (f.= -1.0 sign) +1 +0) exponent-bits (|> exponent frac-to-int int-to-nat (n.+ double-bias) (bit;and exponent-mask)) mantissa-bits (|> mantissa frac-to-int int-to-nat)] @@ -850,10 +844,10 @@ ## else (let [normalized (|> M (bit;set mantissa-size) nat-to-int int-to-frac - (f./ (_lux_proc ["math" "pow"] [2.0 52.0]))) + (f./ ("lux math pow" 2.0 52.0))) power (|> E (n.- double-bias) nat-to-int int-to-frac - [2.0] (_lux_proc ["math" "pow"])) + ("lux math pow" 2.0)) shifted (f.* power normalized)] (if (n.= +0 S) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 835d55fd1..e8eb20b43 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -12,29 +12,29 @@ ## [Functions] (def: #export (size x) (-> Text Nat) - [(_lux_proc ["text" "size"] [x])]) + ("lux text size" x)) (def: #export (nth idx input) (-> Nat Text (Maybe Nat)) - (_lux_proc ["text" "char"] [input idx])) + ("lux text char" input idx)) (def: #export (contains? sub text) (-> Text Text Bool) - (_lux_proc ["text" "contains?"] [text sub])) + ("lux text contains?" text sub)) (do-template [ ] [(def: #export ( input) (-> Text Text) - (_lux_proc ["text" ] [input]))] + ( input))] - [lower-case "lower-case"] - [upper-case "upper-case"] - [trim "trim"] + [lower-case "lux text lower-case"] + [upper-case "lux text upper-case"] + [trim "lux text trim"] ) (def: #export (clip from to input) (-> Nat Nat Text (Maybe Text)) - (_lux_proc ["text" "clip"] [input from to])) + ("lux text clip" input from to)) (def: #export (clip' from input) (-> Nat Text (Maybe Text)) @@ -42,19 +42,19 @@ (def: #export (replace-all pattern value template) (-> Text Text Text Text) - (_lux_proc ["text" "replace-all"] [template pattern value])) + ("lux text replace-all" template pattern value)) (do-template [ ] [(def: #export ( pattern input) (-> Text Text (Maybe Nat)) - (_lux_proc ["text" ] [input pattern ])) + ( input pattern )) (def: #export ( pattern from input) (-> Text Nat Text (Maybe Nat)) - (_lux_proc ["text" ] [input pattern from]))] + ( input pattern from))] - [index-of index-of' "index" +0] - [last-index-of last-index-of' "last-index" (size input)] + [index-of index-of' "lux text index" +0] + [last-index-of last-index-of' "lux text last-index" (size input)] ) (def: #export (starts-with? prefix x) @@ -108,30 +108,30 @@ ## [Structures] (struct: #export _ (Eq Text) (def: (= test subject) - (_lux_proc ["text" "="] [subject test]))) + ("lux text =" subject test))) (struct: #export _ (order;Order Text) (def: eq Eq) (def: (< test subject) - (_lux_proc ["text" "<"] [subject test])) + ("lux text <" subject test)) (def: (<= test subject) - (or (_lux_proc ["text" "<"] [subject test]) - (_lux_proc ["text" "="] [subject test]))) + (or ("lux text <" subject test) + ("lux text =" subject test))) (def: (> test subject) - (_lux_proc ["text" "<"] [test subject])) + ("lux text <" test subject)) (def: (>= test subject) - (or (_lux_proc ["text" "<"] [test subject]) - (_lux_proc ["text" "="] [test subject]))) + (or ("lux text <" test subject) + ("lux text =" test subject))) ) (struct: #export _ (Monoid Text) (def: identity "") (def: (compose left right) - (_lux_proc ["text" "append"] [left right]))) + ("lux text append" left right))) (open Monoid "text/") @@ -153,7 +153,7 @@ (def: eq Eq) (def: (hash input) - (_lux_proc ["text" "hash"] [input]))) + ("lux text hash" input))) (def: #export concat (-> (List Text) Text) @@ -192,7 +192,7 @@ (def: #export (from-code code) (-> Nat Text) - (_lux_proc ["nat" "to-char"] [code])) + ("lux nat to-char" code)) (def: #export (space? char) {#;doc "Checks whether the character is white-space."} diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 85a1cca1e..e9c987532 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -29,19 +29,19 @@ (syntax: #export (set! field-name field-value object) {#;doc (doc "A way to set fields from objects." (set! "foo" 1234 some-object))} - (wrap (list (` (;_lux_proc ["js" "set-field"] [(~ object) (~ field-name) (~ field-value)]))))) + (wrap (list (` ("js set-field" (~ object) (~ field-name) (~ field-value)))))) (syntax: #export (delete! field-name object) {#;doc (doc "A way to delete fields from objects." (delete! "foo" some-object))} - (wrap (list (` (;_lux_proc ["js" "delete-field"] [(~ object) (~ field-name)]))))) + (wrap (list (` ("js delete-field" (~ object) (~ field-name)))))) (syntax: #export (get field-name type object) {#;doc (doc "A way to get fields from objects." (get "ceil" (ref "Math")) (get "ceil" (-> Frac Frac) (ref "Math")))} (wrap (list (` (:! (~ type) - (;_lux_proc ["js" "get-field"] [(~ object) (~ field-name)])))))) + ("js get-field" (~ object) (~ field-name))))))) (syntax: #export (object [kvs (p;some (p;seq s;any s;any))]) {#;doc (doc "A way to create JavaScript objects." @@ -49,7 +49,7 @@ (object "foo" foo "bar" (inc bar)))} (wrap (list (L/fold (function [[k v] object] (` (set! (~ k) (~ v) (~ object)))) - (` (;_lux_proc ["js" "object"] [])) + (` ("js object")) kvs)))) (syntax: #export (ref [name s;text] [type (p;maybe s;any)]) @@ -57,16 +57,16 @@ (ref "document") (ref "Math.ceil" (-> Frac Frac)))} (wrap (list (` (:! (~ (default (' ;;Object) type)) - (;_lux_proc ["js" "ref"] [(~ (code;text name))])))))) + ("js ref" (~ (code;text name)))))))) (do-template [ ] [(syntax: #export () {#;doc (doc ())} - (wrap (list (` (;_lux_proc ["js" ] [])))))] + (wrap (list (` ()))))] - [null "null" "Null object reference."] - [undef "undefined" "Undefined."] + [null "js null" "Null object reference."] + [undef "js undefined" "Undefined."] ) (syntax: #export (call! [shape (p;alt ($_ p;seq s;any (s;tuple (p;some s;any)) (p;maybe s;any)) @@ -77,8 +77,8 @@ (case shape (#;Left [function args ?type]) (wrap (list (` (:! (~ (default (' ;;Object) ?type)) - (;_lux_proc ["js" "call"] [(~ function) (~@ args)]))))) + ("js call" (~ function) (~@ args)))))) (#;Right [object field args ?type]) (wrap (list (` (:! (~ (default (' ;;Object) ?type)) - (;_lux_proc ["js" "object-call"] [(~ object) (~ (code;text field)) (~@ args)]))))))) + ("js object-call" (~ object) (~ (code;text field)) (~@ args)))))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index d8105ca0a..6c3f18b19 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -25,37 +25,37 @@ "To:" )} (-> (primitive ) (primitive )) - (_lux_proc ["jvm" ] [value]))] + ( value))] - [b2l "b2l" java.lang.Byte java.lang.Long] + [b2l "jvm b2l" java.lang.Byte java.lang.Long] - [s2l "s2l" java.lang.Short java.lang.Long] + [s2l "jvm s2l" java.lang.Short java.lang.Long] - [d2i "d2i" java.lang.Double java.lang.Integer] - [d2l "d2l" java.lang.Double java.lang.Long] - [d2f "d2f" java.lang.Double java.lang.Float] + [d2i "jvm d2i" java.lang.Double java.lang.Integer] + [d2l "jvm d2l" java.lang.Double java.lang.Long] + [d2f "jvm d2f" java.lang.Double java.lang.Float] - [f2i "f2i" java.lang.Float java.lang.Integer] - [f2l "f2l" java.lang.Float java.lang.Long] - [f2d "f2d" java.lang.Float java.lang.Double] + [f2i "jvm f2i" java.lang.Float java.lang.Integer] + [f2l "jvm f2l" java.lang.Float java.lang.Long] + [f2d "jvm f2d" java.lang.Float java.lang.Double] - [i2b "i2b" java.lang.Integer java.lang.Byte] - [i2s "i2s" java.lang.Integer java.lang.Short] - [i2l "i2l" java.lang.Integer java.lang.Long] - [i2f "i2f" java.lang.Integer java.lang.Float] - [i2d "i2d" java.lang.Integer java.lang.Double] - [i2c "i2c" java.lang.Integer java.lang.Character] - - [l2b "l2b" java.lang.Long java.lang.Byte] - [l2s "l2s" java.lang.Long java.lang.Short] - [l2i "l2i" java.lang.Long java.lang.Integer] - [l2f "l2f" java.lang.Long java.lang.Float] - [l2d "l2d" java.lang.Long java.lang.Double] - - [c2b "c2b" java.lang.Character java.lang.Byte] - [c2s "c2s" java.lang.Character java.lang.Short] - [c2i "c2i" java.lang.Character java.lang.Integer] - [c2l "c2l" java.lang.Character java.lang.Long] + [i2b "jvm i2b" java.lang.Integer java.lang.Byte] + [i2s "jvm i2s" java.lang.Integer java.lang.Short] + [i2l "jvm i2l" java.lang.Integer java.lang.Long] + [i2f "jvm i2f" java.lang.Integer java.lang.Float] + [i2d "jvm i2d" java.lang.Integer java.lang.Double] + [i2c "jvm i2c" java.lang.Integer java.lang.Character] + + [l2b "jvm l2b" java.lang.Long java.lang.Byte] + [l2s "jvm l2s" java.lang.Long java.lang.Short] + [l2i "jvm l2i" java.lang.Long java.lang.Integer] + [l2f "jvm l2f" java.lang.Long java.lang.Float] + [l2d "jvm l2d" java.lang.Long java.lang.Double] + + [c2b "jvm c2b" java.lang.Character java.lang.Byte] + [c2s "jvm c2s" java.lang.Character java.lang.Short] + [c2i "jvm c2i" java.lang.Character java.lang.Integer] + [c2l "jvm c2l" java.lang.Character java.lang.Long] ) ## [Utils] @@ -519,14 +519,14 @@ (do p;Monad [#let [dotted-name (format "." field-name)] _ (s;this (code;symbol ["" dotted-name]))] - (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" class-name ":" field-name)))] []))))) + (wrap (`' ((~ (code;text (format "jvm getstatic" ":" class-name ":" field-name)))))))) (def: (make-get-var-parser class-name field-name) (-> Text Text (Syntax Code)) (do p;Monad [#let [dotted-name (format "." field-name)] _ (s;this (code;symbol ["" dotted-name]))] - (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this]))))) + (wrap (`' ((~ (code;text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this))))) (def: (make-put-var-parser class-name field-name) (-> Text Text (Syntax Code)) @@ -534,7 +534,7 @@ [#let [dotted-name (format "." field-name)] [_ _ value] (: (Syntax [Unit Unit Code]) (s;form ($_ p;seq (s;this (' :=)) (s;this (code;symbol ["" dotted-name])) s;any)))] - (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)]))))) + (wrap (`' ((~ (code;text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value)))))) (def: (pre-walk-replace f input) (-> (-> Code Code) Code Code) @@ -580,8 +580,8 @@ [[_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (' .new!)) (s;tuple (p;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))] - [(~@ args)]))))) + (wrap (` ((~ (code;text (format "jvm new" ":" class-name ":" (text;join-with "," arg-decls')))) + (~@ args)))))) (def: (make-static-method-parser params class-name method-name arg-decls) (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) @@ -590,8 +590,8 @@ [_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] - [(~@ args)]))))) + (wrap (`' ((~ (code;text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls')))) + (~@ args)))))) (do-template [ ] [(def: ( params class-name method-name arg-decls) @@ -601,11 +601,11 @@ [_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] - [(~' _jvm_this) (~@ args)])))))] + (wrap (`' ((~ (code;text (format ":" class-name ":" method-name ":" (text;join-with "," arg-decls')))) + (~' _jvm_this) (~@ args))))))] - [make-special-method-parser "invokespecial"] - [make-virtual-method-parser "invokevirtual"] + [make-special-method-parser "jvm invokespecial"] + [make-virtual-method-parser "jvm invokevirtual"] ) (def: (method->parser params class-name [[method-name _ _] meth-def]) @@ -1196,8 +1196,8 @@ args (s;tuple (p;exactly (list;size arg-decls) s;any)) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ (list)) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls'))))] - [(~' _jvm_this) (~@ args)]))))))] + (wrap (`' ((~ (code;text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls')))) + (~' _jvm_this) (~@ args)))))))] (with-parens (spaced (list "override" (class-decl$ class-decl) @@ -1312,7 +1312,7 @@ replacer (parser->replacer (list/fold p;either (p;fail "") (list/compose field-parsers method-parsers))) - def-code (format "class:" + def-code (format "jvm class:" (spaced (list (class-decl$ class-decl) (super-class-decl$ super) (with-brackets (spaced (list/map super-class-decl$ interfaces))) @@ -1320,7 +1320,7 @@ (with-brackets (spaced (list/map annotation$ annotations))) (with-brackets (spaced (list/map field-decl$ fields))) (with-brackets (spaced (list/map (method-def$ replacer super) methods))))))]] - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) + (wrap (list (` ((~ (code;text def-code)))))))) (syntax: #export (interface: [#let [imports (class-imports *compiler*)]] [class-decl (class-decl^ imports)] @@ -1335,12 +1335,12 @@ {#;doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} - (let [def-code (format "interface:" + (let [def-code (format "jvm interface:" (spaced (list (class-decl$ class-decl) (with-brackets (spaced (list/map super-class-decl$ supers))) (with-brackets (spaced (list/map annotation$ annotations))) (spaced (list/map method-decl$ members)))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))) + (wrap (list (` ((~ (code;text def-code)))))) )) (syntax: #export (object [#let [imports (class-imports *compiler*)]] @@ -1361,17 +1361,17 @@ (exec (do-something some-value) []))) )} - (let [def-code (format "anon-class:" + (let [def-code (format "jvm anon-class:" (spaced (list (super-class-decl$ super) (with-brackets (spaced (list/map super-class-decl$ interfaces))) (with-brackets (spaced (list/map constructor-arg$ constructor-args))) (with-brackets (spaced (list/map (method-def$ id super) methods))))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) + (wrap (list (` ((~ (code;text def-code)))))))) (syntax: #export (null) {#;doc (doc "Null object reference." (null))} - (wrap (list (` (;_lux_proc ["jvm" "null"] []))))) + (wrap (list (` ("jvm null"))))) (def: #export (null? obj) {#;doc (doc "Test for null object reference." @@ -1382,7 +1382,7 @@ "=>" false)} (-> (primitive java.lang.Object) Bool) - (;_lux_proc ["jvm" "null?"] [obj])) + ("jvm null?" obj)) (syntax: #export (??? expr) {#;doc (doc "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." @@ -1394,7 +1394,7 @@ (#;Some "YOLO"))} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ expr)] - (if (;_lux_proc ["jvm" "null?"] [(~ g!temp)]) + (if ("jvm null?" (~ g!temp)) #;None (#;Some (~ g!temp))))))))) @@ -1413,7 +1413,7 @@ (~ g!value) #;None - (;_lux_proc ["jvm" "null"] [])})))))) + ("jvm null")})))))) (syntax: #export (try expr) {#;doc (doc "Covers the expression in a try-catch block." @@ -1421,7 +1421,7 @@ "If it fails, you get (#;Left error+stack-traces-as-text)." (try (risky-computation input)))} (with-gensyms [g!_] - (wrap (list (`' (_lux_proc ["lux" "try"] [(;function [(~ g!_)] (~ expr))])))))) + (wrap (list (`' ("lux try" (;function [(~ g!_)] (~ expr)))))))) (syntax: #export (instance? [#let [imports (class-imports *compiler*)]] [class (generic-type^ imports (list))] @@ -1431,14 +1431,14 @@ (instance? String "YOLO"))} (case obj (#;Some obj) - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ obj)])))) + (wrap (list (` ((~ (code;text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ obj))))) #;None (do @ [g!obj (meta;gensym "obj")] (wrap (list (` (: (-> (primitive (~' java.lang.Object)) Bool) (function [(~ g!obj)] - (;_lux_proc ["jvm" (~ (code;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ g!obj)]))))))) + ((~ (code;text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj)))))))) )) (syntax: #export (synchronized lock body) @@ -1447,7 +1447,7 @@ (exec (do-something ...) (do-something-else ...) (finish-the-computation ...))))} - (wrap (list (` (;_lux_proc ["jvm" "synchronized"] [(~ lock) (~ body)]))))) + (wrap (list (` ("jvm synchronized" (~ lock) (~ body)))))) (syntax: #export (do-to obj [methods (p;some partial-call^)]) {#;doc (doc "Call a variety of methods on an object; then return the object." @@ -1691,7 +1691,7 @@ (let [getter-name (code;symbol ["" (format method-prefix member-separator name)])] (` (def: (~ getter-name) (~ enum-type) - (;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" name)))] []))))))]] + ((~ (code;text (format "jvm getstatic" ":" full-name ":" name)))))))))]] (wrap (list/map getter-interop enum-members))) (#ConstructorDecl [commons _]) @@ -1699,8 +1699,8 @@ [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) #let [def-name (code;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) def-params (list (code;tuple arg-function-inputs)) - jvm-interop (|> (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" full-name ":" (text;join-with "," arg-classes))))] - [(~@ arg-method-inputs)])) + jvm-interop (|> (` ((~ (code;text (format "jvm new" ":" full-name ":" (text;join-with "," arg-classes)))) + (~@ arg-method-inputs))) (with-mode-inputs (get@ #import-member-mode commons) (list;zip2 arg-classes arg-function-inputs))) [return-type jvm-interop] (|> [return-type jvm-interop] @@ -1739,9 +1739,9 @@ ))) def-params (#;Cons (code;tuple arg-function-inputs) obj-ast) def-param-types (#;Cons (` [(~@ arg-types)]) class-ast) - jvm-interop (|> (` (;_lux_proc ["jvm" (~ (code;text (format jvm-op ":" full-name ":" import-method-name - ":" (text;join-with "," arg-classes))))] - [(~@ obj-ast) (~@ arg-method-inputs)])) + jvm-interop (|> (` ((~ (code;text (format "jvm " jvm-op ":" full-name ":" import-method-name + ":" (text;join-with "," arg-classes)))) + (~@ obj-ast) (~@ arg-method-inputs))) (with-mode-output (get@ #import-member-mode commons) (get@ #import-method-return method)) (with-mode-inputs (get@ #import-member-mode commons) @@ -1781,9 +1781,9 @@ getter-type (` (All [(~@ tvar-asts)] (~ getter-type))) getter-body (if import-field-static? (with-mode-field-get import-field-mode import-field-type - (` (;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" import-field-name)))] []))) + (` ((~ (code;text (format "jvm getstatic" ":" full-name ":" import-field-name)))))) (with-mode-field-get import-field-mode import-field-type - (` (;_lux_proc ["jvm" (~ (code;text (format "getfield" ":" full-name ":" import-field-name)))] [(~ g!obj)])))) + (` ((~ (code;text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj))))) getter-body (if import-field-maybe? (` (??? (~ getter-body))) getter-body) @@ -1805,13 +1805,12 @@ setter-value (if import-field-maybe? (` (!!! (~ setter-value))) setter-value) - setter-command (format (if import-field-static? "putstatic" "putfield") + setter-command (format (if import-field-static? "jvm putstatic" "jvm putfield") ":" full-name ":" import-field-name)] (wrap (: (List Code) (list (` (def: (~ setter-call) (~ setter-type) - (io (;_lux_proc ["jvm" (~ (code;text setter-command))] - [(~ setter-value)]))))))))) + (io ((~ (code;text setter-command)) (~ setter-value)))))))))) (wrap (list)))] (wrap (list& getter-interop setter-interop))) ))) @@ -1828,11 +1827,11 @@ (def: (interface? class) (All [a] (-> (primitive java.lang.Class [a]) Bool)) - (_lux_proc ["jvm" "invokevirtual:java.lang.Class:isInterface:"] [class])) + ("jvm invokevirtual:java.lang.Class:isInterface:" class)) (def: (load-class class-name) (-> Text (Either Text (primitive java.lang.Class [(Ex [a] a)]))) - (try (_lux_proc ["jvm" "invokestatic:java.lang.Class:forName:java.lang.String"] [class-name]))) + (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class-name))) (def: (class-kind [class-name _]) (-> ClassDecl (Meta ClassKind)) @@ -1911,23 +1910,23 @@ (case type (^template [ ] (^ (#GenericClass (list))) - (wrap (list (` (;_lux_proc ["jvm" ] [(~ size)]))))) - (["boolean" "znewarray"] - ["byte" "bnewarray"] - ["short" "snewarray"] - ["int" "inewarray"] - ["long" "lnewarray"] - ["float" "fnewarray"] - ["double" "dnewarray"] - ["char" "cnewarray"]) + (wrap (list (` ( (~ size)))))) + (["boolean" "jvm znewarray"] + ["byte" "jvm bnewarray"] + ["short" "jvm snewarray"] + ["int" "jvm inewarray"] + ["long" "jvm lnewarray"] + ["float" "jvm fnewarray"] + ["double" "jvm dnewarray"] + ["char" "jvm cnewarray"]) _ - (wrap (list (` (;_lux_proc ["jvm" "anewarray"] [(~ (code;text (generic-type$ type))) (~ size)])))))) + (wrap (list (` ("jvm anewarray" (~ (code;text (generic-type$ type))) (~ size))))))) (syntax: #export (array-length array) {#;doc (doc "Gives the length of an array." (array-length my-array))} - (wrap (list (` (;_lux_proc ["jvm" "arraylength"] [(~ array)]))))) + (wrap (list (` ("jvm arraylength" (~ array)))))) (def: (type->class-name type) (-> Type (Meta Text)) @@ -1964,18 +1963,18 @@ (case array-jvm-type (^template [ ] - (wrap (list (` (;_lux_proc ["jvm" ] [(~ array) (~ idx)]))))) - (["[Z" "zaload"] - ["[B" "baload"] - ["[S" "saload"] - ["[I" "iaload"] - ["[J" "jaload"] - ["[F" "faload"] - ["[D" "daload"] - ["[C" "caload"]) + (wrap (list (` ( (~ array) (~ idx)))))) + (["[Z" "jvm zaload"] + ["[B" "jvm baload"] + ["[S" "jvm saload"] + ["[I" "jvm iaload"] + ["[J" "jvm jaload"] + ["[F" "jvm faload"] + ["[D" "jvm daload"] + ["[C" "jvm caload"]) _ - (wrap (list (` (;_lux_proc ["jvm" "aaload"] [(~ array) (~ idx)])))))) + (wrap (list (` ("jvm aaload" (~ array) (~ idx))))))) _ (with-gensyms [g!array] @@ -1993,18 +1992,18 @@ (case array-jvm-type (^template [ ] - (wrap (list (` (;_lux_proc ["jvm" ] [(~ array) (~ idx) (~ value)]))))) - (["[Z" "zastore"] - ["[B" "bastore"] - ["[S" "sastore"] - ["[I" "iastore"] - ["[J" "jastore"] - ["[F" "fastore"] - ["[D" "dastore"] - ["[C" "castore"]) + (wrap (list (` ( (~ array) (~ idx) (~ value)))))) + (["[Z" "jvm zastore"] + ["[B" "jvm bastore"] + ["[S" "jvm sastore"] + ["[I" "jvm iastore"] + ["[J" "jvm jastore"] + ["[F" "jvm fastore"] + ["[D" "jvm dastore"] + ["[C" "jvm castore"]) _ - (wrap (list (` (;_lux_proc ["jvm" "aastore"] [(~ array) (~ idx) (~ value)])))))) + (wrap (list (` ("jvm aastore" (~ array) (~ idx) (~ value))))))) _ (with-gensyms [g!array] @@ -2029,8 +2028,7 @@ (list (code;symbol ["" res-name]) res-ctor)) bindings)) closes (list/map (function [res] - (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"] - [(~ (code;symbol ["" (product;left res)]))])))) + (` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code;symbol ["" (product;left res)])))))) bindings)] (wrap (list (` (do Monad [(~@ inits) @@ -2042,7 +2040,7 @@ [type (generic-type^ imports (list))]) {#;doc (doc "Loads the class as a java.lang.Class object." (class-for java.lang.String))} - (wrap (list (` (;_lux_proc ["jvm" "load-class"] [(~ (code;text (simple-class$ (list) type)))]))))) + (wrap (list (` ("jvm load-class" (~ (code;text (simple-class$ (list) type)))))))) (def: get-compiler (Meta Compiler) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 89f2e0a56..aa317368d 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -12,10 +12,10 @@ (do-template [ ] [(def: #export Frac - (_lux_proc ["math" ] []))] + ())] - [e "e"] - [pi "pi"] + [e "lux math e"] + [pi "lux math pi"] ) (def: #export tau @@ -26,38 +26,38 @@ (do-template [ ] [(def: #export ( input) (-> Frac Frac) - (_lux_proc ["math" ] [input]))] + ( input))] - [cos "cos"] - [sin "sin"] - [tan "tan"] + [cos "lux math cos"] + [sin "lux math sin"] + [tan "lux math tan"] - [acos "acos"] - [asin "asin"] - [atan "atan"] + [acos "lux math acos"] + [asin "lux math asin"] + [atan "lux math atan"] - [cosh "cosh"] - [sinh "sinh"] - [tanh "tanh"] + [cosh "lux math cosh"] + [sinh "lux math sinh"] + [tanh "lux math tanh"] - [exp "exp"] - [log "log"] + [exp "lux math exp"] + [log "lux math log"] - [root2 "root2"] - [root3 "root3"] + [root2 "lux math root2"] + [root3 "lux math root3"] - [ceil "ceil"] - [floor "floor"] - [round "round"] + [ceil "lux math ceil"] + [floor "lux math floor"] + [round "lux math round"] ) (do-template [ ] [(def: #export ( param subject) (-> Frac Frac Frac) - (_lux_proc ["math" ] [subject param]))] + ( subject param))] - [atan2 "atan2"] - [pow "pow"] + [atan2 "lux math atan2"] + [pow "lux math pow"] ) (def: #export (log' base input) diff --git a/stdlib/source/lux/meta/syntax.lux b/stdlib/source/lux/meta/syntax.lux index 4574b9f5d..5587693dd 100644 --- a/stdlib/source/lux/meta/syntax.lux +++ b/stdlib/source/lux/meta/syntax.lux @@ -227,7 +227,7 @@ (with-brackets (spaced (list/map super-class-decl$ interfaces))) (with-brackets (spaced (list/map constructor-arg$ constructor-args))) (with-brackets (spaced (list/map (method-def$ id) methods))))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))))} + (wrap (list (` ((~ (code;text def-code)))))))))} (let [[exported? tokens] (case tokens (^ (list& [_ (#;Tag ["" "hidden"])] tokens')) [(#;Some #;Left) tokens'] diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 2d171f12f..3eae64eee 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -20,7 +20,7 @@ ## [Host] (do-template [ ] [(def: #hidden (IO Bottom) - (io (_lux_proc ["io" "exit"] [])))] + (io ("lux io exit" )))] [exit 0] [die 1] @@ -190,7 +190,7 @@ (wrap (list (` (def: #export (~ g!context) {#;;test (;;_code/text_ (~ description))} (IO Test) - (io (case ((~' _lux_proc) ["lux" "try"] [(io (do ;;Monad [] (~ test)))]) + (io (case ("lux try" [(io (do ;;Monad [] (~ test)))]) (#;Right (~ g!test)) (~ g!test) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 0dea95584..a9d10fd4f 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -309,7 +309,7 @@ (def: #export now (IO Instant) - (io (from-millis (_lux_proc ["io" "current-time"] [])))) + (io (from-millis ("lux io current-time")))) (def: #export (date instant) (-> Instant date;Date) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 9c348720b..4c0d1513f 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -136,10 +136,10 @@ (|> x' (/ y) (* y) (= x')))) ))))] - ["Nat" r;nat n.= n.+ n.- n.* n./ n.% n.> +0 +1 +1000000 %n (n.% +1000) id] - ["Int" r;int i.= i.+ i.- i.* i./ i.% i.> 0 1 1000000 %i (i.% 1000) id] - ["Frac" r;frac f.= f.+ f.- f.* f./ f.% f.> 0.0 1.0 1000000.0 %r id math;floor] - ["Deg" r;deg d.= d.+ d.- d.* d./ d.% d.> .0 (_lux_proc ["deg" "max-value"] []) (_lux_proc ["deg" "max-value"] []) %f id id] + ["Nat" r;nat n.= n.+ n.- n.* n./ n.% n.> +0 +1 +1000000 %n (n.% +1000) id] + ["Int" r;int i.= i.+ i.- i.* i./ i.% i.> 0 1 1000000 %i (i.% 1000) id] + ["Frac" r;frac f.= f.+ f.- f.* f./ f.% f.> 0.0 1.0 1000000.0 %r id math;floor] + ["Deg" r;deg d.= d.+ d.- d.* d./ d.% d.> .0 ("lux deg max-value") ("lux deg max-value") %f id id] ) (do-template [category rand-gen -> <- = %a %z] diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index 33c9fcf79..d41c587c8 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -6,7 +6,7 @@ (data text/format [number] [product] - [text "Text/" Eq]) + [text "text/" Eq]) ["&" host #+ class: interface: object] ["r" math/random]) lux/test) @@ -86,7 +86,7 @@ (&;synchronized "" true)) (test "Can access Class instances." - (Text/= "java.lang.Class" (Class.getName [] (&;class-for java.lang.Class)))) + (text/= "java.lang.Class" (Class.getName [] (&;class-for java.lang.Class)))) (test "Can check if a value is null." (and (&;null? (&;null)) -- cgit v1.2.3