aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux41
-rw-r--r--new-luxc/source/luxc/lang/translation/js/reference.jvm.lux36
-rw-r--r--new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux669
-rw-r--r--new-luxc/source/luxc/lang/translation/js/structure.jvm.lux31
-rw-r--r--stdlib/source/lux/data/text.lux11
-rw-r--r--stdlib/source/lux/host/js.lux120
-rw-r--r--stdlib/source/lux/tool/compiler/phase.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux70
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/primitive.lux53
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/reference.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux718
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux32
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux52
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux9
17 files changed, 1029 insertions, 882 deletions
diff --git a/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux
deleted file mode 100644
index e69291007..000000000
--- a/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux
+++ /dev/null
@@ -1,41 +0,0 @@
-(.module:
- lux
- (lux (control pipe)
- (data [bit]
- [number]
- text/format)
- [macro "meta/" Monad<Meta>])
- [//]
- (// [".T" runtime])
- (luxc (lang (host [js #+ JS Expression Statement]))))
-
-(def: #export translate-bit
- (-> Bit (Meta Expression))
- (|>> %b meta/wrap))
-
-(def: low-mask Nat (dec (bit.left-shift +32 +1)))
-
-(def: #export (translate-int value)
- (-> Int (Meta Expression))
- (let [high (|> value (bit.logical-right-shift +32) %i)
- low (|> value (bit.and low-mask) %i)]
- (meta/wrap (format runtimeT.int//new "(" high "," low ")"))))
-
-(def: #export translate-frac
- (-> Frac (Meta Expression))
- (|>> (cond> [(f/= number.positive-infinity)]
- [(new> "Infinity")]
-
- [(f/= number.negative-infinity)]
- [(new> "-Infinity")]
-
- [(f/= number.not-a-number)]
- [(new> "NaN")]
-
- ## else
- [%f])
- meta/wrap))
-
-(def: #export translate-text
- (-> Text (Meta Expression))
- (|>> %t meta/wrap))
diff --git a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux
deleted file mode 100644
index 69a0075b1..000000000
--- a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux
+++ /dev/null
@@ -1,36 +0,0 @@
-(.module:
- lux
- (lux [macro]
- (data [text]
- text/format))
- (luxc ["&" lang]
- (lang [".L" variable #+ Variable Register]
- (host [js #+ JS Expression Statement])))
- [//]
- (// [".T" runtime]))
-
-(do-template [<register> <translation> <prefix>]
- [(def: #export (<register> register)
- (-> Register Expression)
- (format <prefix> (%i (.int register))))
-
- (def: #export (<translation> register)
- (-> Register (Meta Expression))
- (:: macro.Monad<Meta> wrap (<register> register)))]
-
- [closure translate-captured "c"]
- [variable translate-local "v"])
-
-(def: #export (translate-variable var)
- (-> Variable (Meta Expression))
- (if (variableL.captured? var)
- (translate-captured (variableL.captured-register var))
- (translate-local (.nat var))))
-
-(def: #export global
- (-> Name Expression)
- //.definition-name)
-
-(def: #export (translate-definition name)
- (-> Name (Meta Expression))
- (:: macro.Monad<Meta> wrap (global name)))
diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
deleted file mode 100644
index af47bffce..000000000
--- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
+++ /dev/null
@@ -1,669 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do])
- (data text/format)
- [macro]
- (macro [code]
- ["s" syntax #+ syntax:])
- [io #+ Process])
- [//]
- (luxc (lang (host [js #+ JS Expression Statement]))))
-
-(def: prefix Text "LuxRuntime")
-
-(def: #export unit Expression (%t //.unit))
-
-(def: (flag value)
- (-> Bit JS)
- (if value
- (%t "")
- "null"))
-
-(def: (variant' tag last? value)
- (-> Expression Expression Expression Expression)
- (js.object (list [//.variant-tag-field tag]
- [//.variant-flag-field last?]
- [//.variant-value-field value])))
-
-(def: #export (variant tag last? value)
- (-> Nat Bit Expression Expression)
- (variant' (%i (.int tag)) (flag last?) value))
-
-(def: none
- Expression
- (variant +0 #0 unit))
-
-(def: some
- (-> Expression Expression)
- (variant +1 #1))
-
-(def: left
- (-> Expression Expression)
- (variant +0 #0))
-
-(def: right
- (-> Expression Expression)
- (variant +1 #1))
-
-(type: Runtime JS)
-
-(def: (runtime-name name)
- (-> Text Text)
- (format prefix "$" name))
-
-(def: (feature name definition)
- (-> Text (-> Text Expression) Statement)
- (format "var " name " = " (definition name) ";\n"))
-
-(syntax: (runtime-implementation-name {runtime-name s.local-identifier})
- (wrap (list (code.local-identifier (format "__" runtime-name)))))
-
-(template: (runtime: <lux-name> <js-name> <js-definition>)
- (def: #export <lux-name> Text (runtime-name <js-name>))
- (`` (def: ((~' ~~) (runtime-implementation-name <lux-name>))
- Runtime
- (feature <lux-name>
- (function ((~' _) (~' @))
- <js-definition>)))))
-
-(def: #export (int value)
- (-> Int Expression)
- (format "({"
- //.int-high-field " : " (|> value .nat //.high .int %i)
- ", "
- //.int-low-field " : " (|> value .nat //.low .int %i)
- "})"))
-
-(def: #export frac
- (-> Frac Expression)
- js.number)
-
-(runtime: lux//try "runTry"
- (format "(function " @ "(op) {"
- (format "try {"
- (format "return " (right "op(null)") ";")
- "}"
- "catch(ex) {"
- (format "return " (left "ex.toString()") ";")
- "}")
- "})"))
-
-(runtime: lux//program-args "programArgs"
- (format "(function " @ "() {"
- (format "if(typeof process !== 'undefined' && process.argv) {"
- (format (format "var result = " none ";")
- "for(var idx = process.argv.length-1; idx >= 0; idx--) {"
- (format "result = " (some "[process.argv[idx],result]") ";")
- "}")
- (format "return result;")
- "}"
- "else {"
- (format "return " none ";")
- "}")
- "})"))
-
-(def: runtime//lux
- Runtime
- (format __lux//try
- __lux//program-args))
-
-(runtime: product//left "product_left"
- (format "(function " @ "(product,index) {"
- "var index_min_length = (index+1);"
- "if(product.length > index_min_length) {"
- ## No need for recursion
- "return product[index];"
- "}"
- "else {"
- ## Needs recursion
- "return " @ "(product[product.length - 1], (index_min_length - product.length));"
- "}"
- "})"))
-
-(runtime: product//right "product_right"
- (format "(function " @ "(product,index) {"
- "var index_min_length = (index+1);"
- "if(product.length === index_min_length) {"
- ## Last element.
- "return product[index];"
- "}"
- "else if(product.length < index_min_length) {"
- ## Needs recursion
- "return " @ "(product[product.length - 1], (index_min_length - product.length));"
- "}"
- "else {"
- ## Must slice
- "return product.slice(index);"
- "}"
- "})"))
-
-(runtime: sum//get "sum_get"
- (let [no-match "return null;"
- sum-tag (format "sum." //.variant-tag-field)
- sum-flag (format "sum." //.variant-flag-field)
- sum-value (format "sum." //.variant-value-field)
- is-last? (format sum-flag " === ''")
- extact-match (format "return " sum-value ";")
- test-recursion (format "if(" is-last? ") {"
- ## Must recurse.
- "return " @ "(" sum-value ", (wantedTag - " sum-tag "), wantsLast);"
- "}"
- "else { " no-match " }")]
- (format "(function " @ "(sum,wantedTag,wantsLast) {"
- "if(wantedTag === " sum-tag ") {"
- (format "if(" sum-flag " === wantsLast) {" extact-match "}"
- "else {" test-recursion "}")
- "}"
- (format "else if(wantedTag > " sum-tag ") {" test-recursion "}")
- (format "else if(wantedTag < " sum-tag " && wantsLast === '') {"
- (let [updated-sum (variant' (format "(" sum-tag " - wantedTag)") sum-flag sum-value)]
- (format "return " updated-sum ";"))
- "}")
- "else { " no-match " }"
- "})")))
-
-(def: runtime//adt
- Runtime
- (format __product//left
- __product//right
- __sum//get))
-
-(runtime: int//new "makeI64"
- (format "(function " @ "(high,low) {"
- "return { H: (high|0), L: (low|0)};"
- "})"))
-
-(runtime: int//2^16 "TWO_PWR_16"
- "(1 << 16)")
-
-(runtime: int//2^32 "TWO_PWR_32"
- (format "(" int//2^16 " * " int//2^16 ")"))
-
-(runtime: int//2^64 "TWO_PWR_64"
- (format "(" int//2^32 " * " int//2^32 ")"))
-
-(runtime: int//2^63 "TWO_PWR_63"
- (format "(" int//2^64 " / 2)"))
-
-(runtime: int//unsigned-low "getLowBitsUnsigned"
- (format "(function " @ "(i64) {"
- "return (i64.L >= 0) ? i64.L : (" int//2^32 " + i64.L);"
- "})"))
-
-(runtime: int//to-number "toNumberI64"
- (format "(function " @ "(i64) {"
- "return (i64.H * " int//2^32 ") + " int//unsigned-low "(i64);"
- "})"))
-
-(runtime: int//zero "ZERO"
- "{ H: (0|0), L: (0|0)}")
-
-(runtime: int//min "MIN_VALUE_I64"
- "{ H: (0x80000000|0), L: (0|0)}")
-
-(runtime: int//max "MAX_VALUE_I64"
- "{ H: (0x7FFFFFFF|0), L: (0xFFFFFFFF|0)}")
-
-(runtime: int//one "ONE"
- "{ H: (0|0), L: (1|0)}")
-
-(runtime: int//= "eqI64"
- (format "(function " @ "(l,r) {"
- "return (l.H === r.H) && (l.L === r.L);"
- "})"))
-
-(runtime: int//+ "addI64"
- (format "(function " @ "(l,r) {"
- "var l48 = l.H >>> 16;"
- "var l32 = l.H & 0xFFFF;"
- "var l16 = l.L >>> 16;"
- "var l00 = l.L & 0xFFFF;"
-
- "var r48 = r.H >>> 16;"
- "var r32 = r.H & 0xFFFF;"
- "var r16 = r.L >>> 16;"
- "var r00 = r.L & 0xFFFF;"
-
- "var x48 = 0, x32 = 0, x16 = 0, x00 = 0;"
- "x00 += l00 + r00;"
- "x16 += x00 >>> 16;"
- "x00 &= 0xFFFF;"
- "x16 += l16 + r16;"
- "x32 += x16 >>> 16;"
- "x16 &= 0xFFFF;"
- "x32 += l32 + r32;"
- "x48 += x32 >>> 16;"
- "x32 &= 0xFFFF;"
- "x48 += l48 + r48;"
- "x48 &= 0xFFFF;"
-
- "return " int//new "((x48 << 16) | x32, (x16 << 16) | x00);"
- "})"))
-
-(template: (bit-operation: <lux-name> <js-name> <op>)
- (runtime: <lux-name> <js-name>
- (format "(function " (~' @) "(input,mask) {"
- "return " int//new "(input.H " <op> " mask.H, input.L " <op> " mask.L);"
- "})")))
-
-(bit-operation: bit//and "andI64" "&")
-(bit-operation: bit//or "orI64" "|")
-(bit-operation: bit//xor "xorI64" "^")
-
-(runtime: bit//not "notI64"
- (format "(function " @ "(i64) {"
- "return " int//new "(~i64.H,~i64.L);"
- "})"))
-
-(runtime: int//negate "negateI64"
- (format "(function " @ "(i64) {"
- (format "if(" int//= "(" int//min ",i64)) {"
- "return " int//min ";"
- "}")
- (format "else {"
- "return " int//+ "(" bit//not "(i64)," int//one ");"
- "}")
- "})"))
-
-(runtime: int//-one "NEG_ONE"
- (js.apply int//negate (list int//one)))
-
-(runtime: int//from-number "fromNumberI64"
- (format "(function " @ "(num) {"
- (format "if(isNaN(num)) {"
- "return " int//zero ";"
- "}")
- (format "else if(num <= -" int//2^63 ") {"
- "return " int//min ";"
- "}")
- (format "else if((num + 1) >= " int//2^63 ") {"
- "return " int//max ";"
- "}")
- (format "else if(num < 0) {"
- "return " int//negate "(" @ "(-num));"
- "}")
- (format "else {"
- "return " int//new "((num / " int//2^32 "), (num % " int//2^32 "));"
- "}")
- "})"))
-
-(runtime: bit//left-shift "shlI64"
- (format "(function " @ "(input,shift) {"
- "shift &= 63;"
- (format "if(shift === 0) {"
- "return input;"
- "}"
- "else {"
- (format "if (shift < 32) {"
- "var high = (input.H << shift) | (input.L >>> (32 - shift));"
- "var low = input.L << shift;"
- "return " int//new "(high, low);"
- "}"
- "else {"
- "var high = (input.L << (shift - 32));"
- "return " int//new "(high, 0);"
- "}")
- "}")
- "})"))
-
-(runtime: bit//arithmetic-right-shift "shrI64"
- (format "(function " @ "(input,shift) {"
- "shift &= 63;"
- (format "if(shift === 0) {"
- "return input;"
- "}"
- "else {"
- (format "if (shift < 32) {"
- "var high = input.H >> shift;"
- "var low = (input.L >>> shift) | (input.H << (32 - shift));"
- "return " int//new "(high, low);"
- "}"
- "else {"
- "var low = (input.H >> (shift - 32));"
- "var high = input.H >= 0 ? 0 : -1;"
- "return " int//new "(high, low);"
- "}")
- "}")
- "})"))
-
-(runtime: bit//logical-right-shift "ushrI64"
- (format "(function " @ "(input,shift) {"
- "shift &= 63;"
- (format "if(shift === 0) {"
- "return input;"
- "}"
- "else {"
- (format "if (shift < 32) {"
- "var high = input.H >>> shift;"
- "var low = (input.L >>> shift) | (input.H << (32 - shift));"
- "return " int//new "(high, low);"
- "}"
- "else if(shift === 32) {"
- "return " int//new "(0, input.H);"
- "}"
- "else {"
- "var low = (input.H >>> (shift - 32));"
- "return " int//new "(0, low);"
- "}")
- "}")
- "})"))
-
-(def: runtime//bit
- Runtime
- (format __bit//and
- __bit//or
- __bit//xor
- __bit//not
- __bit//left-shift
- __bit//arithmetic-right-shift
- __bit//logical-right-shift))
-
-(runtime: int//- "subI64"
- (format "(function " @ "(l,r) {"
- "return " int//+ "(l, " int//negate "(r));"
- "})"))
-
-(runtime: int//* "mulI64"
- (format "(function " @ "(l,r) {"
- "if (l.H < 0) {"
- (format "if (r.H < 0) {"
- ## Both are negative
- "return " @ "( " int//negate "(l), " int//negate "(r));"
- "}"
- "else {"
- ## Left is negative
- "return " int//negate "(" @ "( " int//negate "(l),r));"
- "}")
- "}"
- "else if (r.H < 0) {"
- ## Right is negative
- "return " int//negate "(" @ "(l, " int//negate "(r)));"
- "}"
- ## Both are positive
- "else {"
- "var l48 = l.H >>> 16;"
- "var l32 = l.H & 0xFFFF;"
- "var l16 = l.L >>> 16;"
- "var l00 = l.L & 0xFFFF;"
-
- "var r48 = r.H >>> 16;"
- "var r32 = r.H & 0xFFFF;"
- "var r16 = r.L >>> 16;"
- "var r00 = r.L & 0xFFFF;"
-
- "var x48 = 0, x32 = 0, x16 = 0, x00 = 0;"
- "x00 += l00 * r00;"
- "x16 += x00 >>> 16;"
- "x00 &= 0xFFFF;"
- "x16 += l16 * r00;"
- "x32 += x16 >>> 16;"
- "x16 &= 0xFFFF;"
- "x16 += l00 * r16;"
- "x32 += x16 >>> 16;"
- "x16 &= 0xFFFF;"
- "x32 += l32 * r00;"
- "x48 += x32 >>> 16;"
- "x32 &= 0xFFFF;"
- "x32 += l16 * r16;"
- "x48 += x32 >>> 16;"
- "x32 &= 0xFFFF;"
- "x32 += l00 * r32;"
- "x48 += x32 >>> 16;"
- "x32 &= 0xFFFF;"
- "x48 += (l48 * r00) + (l32 * r16) + (l16 * r32) + (l00 * r48);"
- "x48 &= 0xFFFF;"
-
- "return " int//new "((x48 << 16) | x32, (x16 << 16) | x00);"
- "}"
- "})"))
-
-(runtime: int//< "ltI64"
- (format "(function " @ "(l,r) {"
- "var ln = l.H < 0;"
- "var rn = r.H < 0;"
- "if(ln && !rn) { return true; }"
- "if(!ln && rn) { return false; }"
- "return (" int//- "(l,r).H < 0);"
- "})"))
-
-(def: (<I param subject)
- (-> Expression Expression Expression)
- (js.apply int//< (list subject param)))
-
-(def: (<=I param subject)
- (-> Expression Expression Expression)
- (js.or (js.apply int//< (list subject param))
- (js.apply int//= (list subject param))))
-
-(def: (>I param subject)
- (-> Expression Expression Expression)
- (js.apply int//< (list param subject)))
-
-(def: (>=I param subject)
- (-> Expression Expression Expression)
- (js.or (js.apply int//< (list param subject))
- (js.apply int//= (list subject param))))
-
-(def: (=I reference sample)
- (-> Expression Expression Expression)
- (js.apply int//= (list sample reference)))
-
-(runtime: int/// "divI64"
- (let [negate (|>> (list) (js.apply int//negate))
- negative? (function (_ value)
- (js.apply int//< (list value int//zero)))
- valid-division-check [(=I int//zero "parameter")
- (js.throw! (js.string "Cannot divide by zero!"))]
- short-circuit-check [(=I int//zero "subject")
- (js.return! int//zero)]
- recur (function (_ subject parameter)
- (js.apply @ (list subject parameter)))]
- (js.function @ (list "subject" "parameter")
- (list (js.cond! (list valid-division-check
- short-circuit-check
-
- [(=I int//min "subject")
- (js.cond! (list [(js.or (=I int//one "parameter")
- (=I int//-one "parameter"))
- (js.return! int//min)]
- [(=I int//min "parameter")
- (js.return! int//one)])
- (js.block! (list (js.var! "approximation"
- (#.Some (js.apply bit//left-shift
- (list (recur (js.apply bit//arithmetic-right-shift
- (list "subject" (js.number 1.0)))
- "parameter")
- (js.number 1.0)))))
- (js.if! (=I int//zero "approximation")
- (js.return! (js.? (negative? "parameter")
- int//one
- int//-one))
- (let [remainder (js.apply int//- (list "subject"
- (js.apply int//* (list "parameter"
- "approximation"))))
- result (js.apply int//+ (list "approximation"
- (recur remainder
- "parameter")))]
- (js.return! result))))))]
- [(=I int//min "parameter")
- (js.return! int//zero)]
-
- [(negative? "subject")
- (js.return! (js.? (negative? "parameter")
- (recur (negate "subject")
- (negate "parameter"))
- (negate (recur (negate "subject")
- "parameter"))))]
-
- [(negative? "parameter")
- (js.return! (negate (recur "subject" (negate "parameter"))))])
- (js.block! (list (js.var! "result" (#.Some int//zero))
- (js.var! "remainder" (#.Some "subject"))
- (js.while! (>=I "parameter" "remainder")
- (let [rough-estimate (js.apply "Math.floor" (list (js./ (js.apply int//to-number (list "parameter"))
- (js.apply int//to-number (list "remainder")))))
- log2 (js./ "Math.LN2"
- (js.apply "Math.log" (list "approximate")))
- approx-result (js.apply int//from-number (list "approximate"))
- approx-remainder (js.apply int//* (list "approximate_result" "parameter"))]
- (list (js.var! "approximate" (#.Some (js.apply "Math.max" (list (js.number 1.0)
- rough-estimate))))
- (js.var! "log2" (#.Some (js.apply "Math.ceil" (list log2))))
- (js.var! "delta" (#.Some (js.? (js.<= (js.number 48.0) "log2")
- (js.number 1.0)
- (js.apply "Math.pow" (list (js.number 2.0)
- (js.- (js.number 48.0)
- "log2"))))))
- (js.var! "approximate_result" (#.Some approx-result))
- (js.var! "approximate_remainder" (#.Some approx-remainder))
- (js.while! (js.or (negative? "approximate_remainder")
- (>I "remainder"
- "approximate_remainder"))
- (list (js.set! "approximate" (js.- "delta" "approximate"))
- (js.set! "approximate_result" approx-result)
- (js.set! "approximate_remainder" approx-remainder)))
- (js.block! (list (js.set! "result" (js.apply int//+ (list "result"
- (js.? (=I int//zero "approximate_result")
- int//one
- "approximate_result"))))
- (js.set! "remainder" (js.apply int//- (list "remainder" "approximate_remainder"))))))))
- (js.return! "result")))
- )))))
-
-(runtime: int//% "remI64"
- (js.function @ (list "subject" "parameter")
- (list (let [flat (js.apply int//* (list (js.apply int/// (list "subject" "parameter"))
- "parameter"))]
- (js.return! (js.apply int//- (list "subject" flat)))))))
-
-(def: runtime//int
- Runtime
- (format __int//2^16
- __int//2^32
- __int//2^64
- __int//2^63
- __int//unsigned-low
- __int//zero
- __int//new
- __int//min
- __int//max
- __int//one
- __int//=
- __int//+
- __int//negate
- __int//to-number
- __int//from-number
- __int//-
- __int//*
- __int//<
- __int///
- __int//%))
-
-(runtime: text//index "index"
- (format "(function " @ "(text,part,start) {"
- "var idx = text.indexOf(part," int//to-number "(start));"
- (format (format "if(idx === -1) {"
- "return " none ";"
- "}")
- (format "else {"
- (format "return " (some (format int//from-number "(idx)")) ";")
- "}"))
- "})"))
-
-(runtime: text//clip "clip"
- (format "(function " @ "(text,from,to) {"
- (format "if(from.L > text.length || to.L > text.length) {"
- (format "return " none ";")
- "}"
- "else {"
- (format "return " (some "text.substring(from.L,to.L)") ";")
- "}")
- "})"))
-
-(runtime: text//char "textChar"
- (format "(function " @ "(text,idx) {"
- "var result = text.charCodeAt(idx.L);"
- (format "if(result === NaN) {"
- (format "return " none ";")
- "}"
- "else {"
- (format "return " (some (format int//from-number "(result)")) ";")
- "}")
- "})"))
-
-(def: runtime//text
- Runtime
- (format __text//index
- __text//clip
- __text//char))
-
-(runtime: io//log "log"
- (format "(function " @ "(message) {"
- "if(typeof console !== \"undefined\" && console.log) { console.log(message); }"
- "else if(typeof print !== \"undefined\") { print(message); }"
- "return " unit ";"
- "})"))
-
-(runtime: io//error "error"
- (format "(function " @ "(message) {"
- "throw new Error(message);"
- "})"))
-
-(def: runtime//io
- Runtime
- (format __io//log
- __io//error))
-
-(runtime: js//get "jsGetField"
- (format "(function " @ "(object, field) {"
- "var temp = object[field];"
- (format "if(temp !== undefined) {"
- (format "return " (some "temp") ";")
- "}"
- "else {"
- (format "return " none ";")
- "}")
- "})"))
-
-(runtime: js//set "jsSetField"
- (format "(function " @ "(object, field, input) {"
- "object[field] = input;"
- "return object;"
- "})"))
-
-(runtime: js//delete "jsDeleteField"
- (format "(function " @ "(object, field) {"
- "delete object[field];"
- "return object;"
- "})"))
-
-(runtime: js//call "jsObjectCall"
- (format "(function " @ "(object, method, args) {"
- "return object[method].apply(object, args);"
- "})"))
-
-(def: runtime//js
- Runtime
- (format __js//get
- __js//set
- __js//delete
- __js//call))
-
-(def: runtime
- Runtime
- (format runtime//lux
- runtime//adt
- runtime//bit
- runtime//int
- runtime//text
- runtime//io
- runtime//js))
-
-(def: #export artifact Text (format prefix ".js"))
-
-(def: #export translate
- (Meta (Process Any))
- (do macro.Monad<Meta>
- [_ //.init-module-buffer
- _ (//.save-js runtime)]
- (//.save-module! artifact)))
diff --git a/new-luxc/source/luxc/lang/translation/js/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/js/structure.jvm.lux
deleted file mode 100644
index 580f48807..000000000
--- a/new-luxc/source/luxc/lang/translation/js/structure.jvm.lux
+++ /dev/null
@@ -1,31 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do])
- (data [text]
- text/format)
- [macro])
- (luxc ["&" lang]
- (lang [synthesis #+ Synthesis]
- (host [js #+ JS Expression Statement])))
- [//]
- (// [".T" runtime]))
-
-(def: #export (translate-tuple translate elemsS+)
- (-> (-> Synthesis (Meta Expression)) (List Synthesis) (Meta Expression))
- (case elemsS+
- #.Nil
- (:: macro.Monad<Meta> wrap runtimeT.unit)
-
- (#.Cons singletonS #.Nil)
- (translate singletonS)
-
- _
- (do macro.Monad<Meta>
- [elemsT+ (monad.map @ translate elemsS+)]
- (wrap (format "[" (text.join-with "," elemsT+) "]")))))
-
-(def: #export (translate-variant translate tag tail? valueS)
- (-> (-> Synthesis (Meta Expression)) Nat Bit Synthesis (Meta Expression))
- (do macro.Monad<Meta>
- [valueT (translate valueS)]
- (wrap (runtimeT.variant tag tail? valueT))))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 9be782e65..29bbd98ab 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -233,11 +233,18 @@
"" #1
_ #0))
+(def: #export (prefix param subject)
+ (-> Text Text Text)
+ ("lux text concat" param subject))
+
+(def: #export (suffix param subject)
+ (-> Text Text Text)
+ ("lux text concat" subject param))
+
(def: #export (enclose [left right] content)
{#.doc "Surrounds the given content text with left and right side additions."}
(-> [Text Text] Text Text)
- (let [(^open ".") ..monoid]
- ($_ "lux text concat" left content right)))
+ ($_ "lux text concat" left content right))
(def: #export (enclose' boundary content)
{#.doc "Surrounds the given content text with the same boundary text."}
diff --git a/stdlib/source/lux/host/js.lux b/stdlib/source/lux/host/js.lux
index e10c0395f..fbaf12fc3 100644
--- a/stdlib/source/lux/host/js.lux
+++ b/stdlib/source/lux/host/js.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Code or and function if cond undefined false true)
+ [lux (#- Code or and function if cond undefined for false true not)
[control
[pipe (#+ case>)]]
[data
@@ -49,6 +49,9 @@
[undefined "undefined"]
[false "false"]
[true "true"]
+ [positive-infinity "Infinity"]
+ [negative-infinity "-Infinity"]
+ [not-a-number "NaN"]
)
(def: #export boolean
@@ -102,11 +105,11 @@
:abstraction))
(def: #export (the field object)
- (-> Var Expression Access)
- (:abstraction (format (:representation object) "." (:representation field))))
+ (-> Text Expression Access)
+ (:abstraction (format (:representation object) "." field)))
(def: #export (do method inputs object)
- (-> Var (List Expression) Expression Access)
+ (-> Text (List Expression) Expression Access)
(|> (format (:representation (..the method object))
(|> inputs
(list/map ..code)
@@ -116,7 +119,7 @@
:abstraction))
(def: #export object
- (-> (List [Text Computation]) Computation)
+ (-> (List [Text Expression]) Computation)
(|>> (list/map (.function (_ [key val])
(format (:representation (..string key)) ..field-separator (:representation val))))
(text.join-with ..argument-separator)
@@ -130,9 +133,16 @@
(def: #export (then pre post)
(-> Statement Statement Statement)
- (:abstraction (format (:representation pre) " " (:representation post))))
+ (:abstraction (format (text.suffix ..statement-suffix
+ (:representation pre))
+ " "
+ (:representation post))))
- (def: block (-> Statement Text) (|>> :representation (text.enclose ["{" "}"])))
+ (def: block
+ (-> Statement Text)
+ (|>> :representation
+ (text.suffix ..statement-suffix)
+ (text.enclose ["{" "}"])))
(def: #export (function name inputs body)
(-> Var (List Var) Statement Computation)
@@ -160,7 +170,7 @@
..argument
:abstraction))
- (def: #export (apply function inputs)
+ (def: #export (apply/* function inputs)
(-> Expression (List Expression) Computation)
(|> inputs
(list/map ..code)
@@ -169,6 +179,27 @@
(format (:representation function))
:abstraction))
+ (do-template [<apply> <arg>+ <type>+ <function>+]
+ [(`` (def: #export (<apply> function)
+ (-> Expression (~~ (template.splice <type>+)) Computation)
+ (.function (_ (~~ (template.splice <arg>+)))
+ (..apply/* function (list (~~ (template.splice <arg>+)))))))
+
+ (`` (do-template [<definition> <function>]
+ [(def: #export <definition> (<apply> (..var <function>)))]
+
+ (~~ (template.splice <function>+))))]
+
+ [apply/1 [_0] [Expression]
+ [[not-a-number? "isNaN"]]]
+
+ [apply/2 [_0 _1] [Expression Expression]
+ []]
+
+ [apply/3 [_0 _1 _2] [Expression Expression Expression]
+ []]
+ )
+
(do-template [<name> <op>]
[(def: #export (<name> param subject)
(-> Expression Expression Computation)
@@ -188,12 +219,27 @@
[/ "/"]
[% "%"]
+ [left-shift "<<"]
+ [arithmetic-right-shift ">>"]
+ [logic-right-shift ">>>"]
+
[or "||"]
[and "&&"]
+ [bit-xor "^"]
[bit-or "|"]
[bit-and "&"]
)
+ (do-template [<name> <prefix>]
+ [(def: #export <name>
+ (-> Expression Computation)
+ (|>> :representation (text.prefix <prefix>) ..argument :abstraction))]
+
+ [not "!"]
+ [bit-not "~"]
+ [negate "-"]
+ )
+
(def: #export (i32 value)
{#.doc "A 32-bit integer expression."}
(-> Int Computation)
@@ -214,21 +260,37 @@
..argument
:abstraction))
+ (def: #export statement
+ (-> Expression Statement)
+ (|>> :transmutation))
+
(def: #export use-strict
Statement
- (:abstraction (format text.double-quote "use strict" text.double-quote ..statement-suffix)))
+ (:abstraction (format text.double-quote "use strict" text.double-quote)))
(def: #export (declare name)
(-> Var Statement)
- (:abstraction (format "var " (:representation name) ..statement-suffix)))
+ (:abstraction (format "var " (:representation name))))
(def: #export (define name value)
(-> Var Expression Statement)
- (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement-suffix)))
+ (:abstraction (format "var " (:representation name) " = " (:representation value))))
(def: #export (set name value)
(-> Location Expression Statement)
- (:abstraction (format (:representation name) " = " (:representation value) ..statement-suffix)))
+ (:abstraction (format (:representation name) " = " (:representation value))))
+
+ (def: #export (throw message)
+ (-> Expression Statement)
+ (:abstraction (format "throw new Error(" (:representation message) ")")))
+
+ (def: #export (return value)
+ (-> Expression Statement)
+ (:abstraction (format "return " (:representation value))))
+
+ (def: #export (delete value)
+ (-> Location Statement)
+ (:abstraction (format "delete " (:representation value))))
(def: #export (if test then! else!)
(-> Expression Statement Statement Statement)
@@ -242,17 +304,31 @@
(:abstraction (format "while(" (:representation test) ") "
(..block body))))
- (def: #export (throw message)
- (-> Expression Statement)
- (:abstraction (format "throw Error(" (:representation message) ")" ..statement-suffix)))
-
- (def: #export (return value)
- (-> Expression Statement)
- (:abstraction (format "return " (:representation value) ..statement-suffix)))
+ (def: #export (try body [exception catch])
+ (-> Statement [Var Statement] Statement)
+ (:abstraction (format "try "
+ (..block body)
+ " catch(" (:representation exception) ") "
+ (..block body))))
- (def: #export (delete value)
- (-> Location Statement)
- (:abstraction (format "delete " (:representation value) ..statement-suffix)))
+ (def: #export (for var init condition update iteration)
+ (-> Var Expression Expression Statement Statement Statement)
+ (:abstraction (format "for(" (:representation (..define var init))
+ ..statement-suffix " " (:representation condition)
+ ..statement-suffix " " (:representation update)
+ ")"
+ (..block iteration))))
+
+ (do-template [<name> <js>]
+ [(def: #export <name>
+ (-> Location Statement)
+ (|>> :representation
+ (text.suffix <js>)
+ :abstraction))]
+
+ [++ "++"]
+ [-- "--"]
+ )
)
(def: #export (cond clauses else!)
diff --git a/stdlib/source/lux/tool/compiler/phase.lux b/stdlib/source/lux/tool/compiler/phase.lux
index 66abcc6cd..909b7e9e9 100644
--- a/stdlib/source/lux/tool/compiler/phase.lux
+++ b/stdlib/source/lux/tool/compiler/phase.lux
@@ -20,7 +20,7 @@
(state.State' Error s o))
(def: #export monad
- (state.monad error.monad))
+ (state.with-state error.monad))
(type: #export (Phase s i o)
(-> i (Operation s o)))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation.lux b/stdlib/source/lux/tool/compiler/phase/translation.lux
index d8522adcd..6ee7f3841 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation.lux
@@ -13,10 +13,10 @@
["." row (#+ Row)]
["." dictionary (#+ Dictionary)]]]
[world
- [file (#+ File)]]]
+ [file (#+ Path)]]]
["." //
- ["." extension]]
- [//synthesis (#+ Synthesis)])
+ [synthesis (#+ Synthesis)]
+ ["." extension]])
(do-template [<name>]
[(exception: #export (<name>)
@@ -61,7 +61,7 @@
(type: #export (Buffer statement) (Row [Name statement]))
-(type: #export (Outputs statement) (Dictionary File (Buffer statement)))
+(type: #export (Outputs statement) (Dictionary Path (Buffer statement)))
(type: #export (State anchor expression statement)
{#context Context
@@ -216,7 +216,7 @@
(def: #export (save-buffer! target)
(All [anchor expression statement]
- (-> File (Operation anchor expression statement Any)))
+ (-> Path (Operation anchor expression statement Any)))
(do //.monad
[buffer ..buffer]
(extension.update (update@ #outputs (dictionary.put target buffer)))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux b/stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux
new file mode 100644
index 000000000..5d85bfd16
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux
@@ -0,0 +1,70 @@
+(.module:
+ [lux #*
+ [control
+ pipe]
+ [data
+ [text
+ format]]
+ [type (#+ :share)]]
+ [//
+ ["/." //
+ ["//." // ("#/." monad)
+ [synthesis (#+ Synthesis)]
+ [//
+ ["." reference (#+ Register Variable Reference)]]]]])
+
+(signature: #export (System expression)
+ (: (-> Register expression)
+ local)
+ (: (-> Register expression)
+ foreign)
+ (: (All [anchor statement]
+ (-> Variable (///.Operation anchor expression statement)))
+ variable)
+ (: (All [anchor statement]
+ (-> Name (///.Operation anchor expression statement)))
+ constant)
+ (: (All [anchor statement]
+ (-> Reference (///.Operation anchor expression statement)))
+ reference))
+
+(def: (variable-maker prefix variable)
+ (All [expression]
+ (-> Text (-> Text expression)
+ (-> Register expression)))
+ (|>> .int %i (format prefix) variable))
+
+(def: #export (system constant variable)
+ (All [expression]
+ (-> (-> Text expression) (-> Text expression)
+ (System expression)))
+ (let [local (variable-maker "l" variable)
+ foreign (variable-maker "f" variable)
+ variable (:share [expression]
+ {(-> Text expression)
+ variable}
+ {(All [anchor statement]
+ (-> Variable (///.Operation anchor expression statement)))
+ (|>> (case> (#reference.Local register)
+ (local register)
+
+ (#reference.Foreign register)
+ (foreign register))
+ /////wrap)})
+ constant (:share [expression]
+ {(-> Text expression)
+ constant}
+ {(All [anchor statement]
+ (-> Name (///.Operation anchor expression statement)))
+ (|>> ///.remember (/////map constant))})]
+ (structure
+ (def: local local)
+ (def: foreign foreign)
+ (def: variable variable)
+ (def: constant constant)
+ (def: reference
+ (|>> (case> (#reference.Constant value)
+ (constant value)
+
+ (#reference.Variable value)
+ (variable value)))))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/primitive.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/primitive.lux
new file mode 100644
index 000000000..d99eec0e9
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/primitive.lux
@@ -0,0 +1,53 @@
+(.module:
+ [lux (#- int)
+ [control
+ [pipe (#+ cond> new>)]]
+ [data
+ [number
+ ["." i64]
+ ["." frac]]
+ [text
+ format]]
+ [host
+ ["_" js (#+ Expression)]]]
+ [//
+ ["//." runtime (#+ Operation)]
+ [//
+ ["//." // ("#/." monad)]]])
+
+(def: #export bit
+ (-> Bit (Operation Expression))
+ (|>> _.boolean /////wrap))
+
+(def: high
+ (-> Int Int)
+ (i64.logic-right-shift 32))
+
+(def: low
+ (-> Int Int)
+ (let [mask (dec (i64.left-shift 32 1))]
+ (|>> (i64.and mask))))
+
+(def: #export (int value)
+ (-> Int (Operation Expression))
+ (/////wrap (//runtime.i64//new (|> value ..high _.i32)
+ (|> value ..low _.i32))))
+
+(def: #export frac
+ (-> Frac (Operation Expression))
+ (|>> (cond> [(f/= frac.positive-infinity)]
+ [(new> _.positive-infinity [])]
+
+ [(f/= frac.negative-infinity)]
+ [(new> _.negative-infinity [])]
+
+ [(f/= frac.not-a-number)]
+ [(new> _.not-a-number [])]
+
+ ## else
+ [_.number])
+ /////wrap))
+
+(def: #export text
+ (-> Text (Operation Expression))
+ (|>> _.string /////wrap))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/reference.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/reference.lux
new file mode 100644
index 000000000..0e4cd1489
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/reference.lux
@@ -0,0 +1,12 @@
+(.module:
+ [lux #*
+ [host
+ ["_" js (#+ Expression)]]]
+ [//
+ [//
+ [common
+ ["." reference]]]])
+
+(def: #export system
+ (reference.system (: (-> Text Expression) _.var)
+ (: (-> Text Expression) _.var)))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux
new file mode 100644
index 000000000..c8e86dcb5
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux
@@ -0,0 +1,718 @@
+(.module:
+ [lux #*
+ ["." function]
+ [control
+ [monad (#+ do)]
+ ["p" parser]]
+ [data
+ [number (#+ hex)]
+ ["." text
+ format]
+ [collection
+ ["." list ("#/." functor)]]]
+ ["." macro
+ ["." code]
+ ["s" syntax (#+ syntax:)]]
+ [host
+ ["_" js (#+ Expression Var Computation Statement)]]]
+ ["." ///
+ ["//." //
+ ["." synthesis]]]
+ )
+
+(do-template [<name> <base>]
+ [(type: #export <name>
+ (<base> Var Expression Statement))]
+
+ [Operation ///.Operation]
+ [Phase ///.Phase]
+ [Handler ///.Handler]
+ [Bundle ///.Bundle]
+ )
+
+(type: #export (Generator i)
+ (-> i Phase (Operation Expression)))
+
+(def: prefix Text "LuxRuntime")
+
+(def: #export variant-tag-field "_lux_tag")
+(def: #export variant-flag-field "_lux_flag")
+(def: #export variant-value-field "_lux_value")
+
+(def: #export unit Computation (_.string synthesis.unit))
+
+(def: #export (flag value)
+ (-> Bit Computation)
+ (if value
+ (_.string "")
+ _.null))
+
+(def: #export (variant tag last? value)
+ (-> Expression Expression Expression Computation)
+ (_.object (list [..variant-tag-field tag]
+ [..variant-flag-field last?]
+ [..variant-value-field value])))
+
+(def: none
+ Computation
+ (..variant (_.i32 +0) (flag #0) unit))
+
+(def: some
+ (-> Expression Computation)
+ (..variant (_.i32 +1) (flag #1)))
+
+(def: left
+ (-> Expression Computation)
+ (..variant (_.i32 +0) (flag #0)))
+
+(def: right
+ (-> Expression Computation)
+ (..variant (_.i32 +1) (flag #1)))
+
+(def: sanitize
+ (-> Text Text)
+ (|>> (text.replace-all "/" "_SL")
+ (text.replace-all "-" "_DS")
+ (text.replace-all "^" "_CR")
+ (text.replace-all "=" "_EQ")
+ (text.replace-all "+" "_PL")
+ (text.replace-all "*" "_ST")))
+
+(def: variable
+ (-> Text Var)
+ (|>> ..sanitize
+ _.var))
+
+(def: runtime-name
+ (-> Text Var)
+ (|>> ..sanitize
+ (format prefix "$")
+ _.var))
+
+(def: (feature name definition)
+ (-> Var (-> Var Expression) Statement)
+ (_.define name (definition name)))
+
+(syntax: (code-name {definition-name s.local-identifier})
+ (wrap (list (code.local-identifier (format "@" definition-name)))))
+
+(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))}
+ body)
+ (wrap (list (` (let [(~+ (|> vars
+ (list/map (function (_ var)
+ (list (code.local-identifier var)
+ (` (_.var (~ (code.text var)))))))
+ list.concat))]
+ (~ body))))))
+
+(syntax: (runtime: {declaration (p.or s.local-identifier
+ (s.form (p.and s.local-identifier
+ (p.some s.local-identifier))))}
+ code)
+ (case declaration
+ (#.Left name)
+ (macro.with-gensyms [g!_]
+ (let [nameC (code.local-identifier name)
+ code-nameC (code.local-identifier (format "@" name))
+ runtime-nameC (` (runtime-name (~ (code.text name))))]
+ (wrap (list (` (def: #export (~ nameC) Var (~ runtime-nameC)))
+ (` (def: (~ code-nameC)
+ Statement
+ (..feature (~ runtime-nameC)
+ (function ((~ g!_) (~ nameC))
+ (~ code)))))))))
+
+ (#.Right [name inputs])
+ (macro.with-gensyms [g!_]
+ (let [nameC (code.local-identifier name)
+ code-nameC (code.local-identifier (format "@" name))
+ runtime-nameC (` (runtime-name (~ (code.text name))))
+ inputsC (list/map code.local-identifier inputs)
+ inputs-typesC (list/map (function.constant (` _.Expression)) inputs)]
+ (wrap (list (` (def: #export ((~ nameC) (~+ inputsC))
+ (-> (~+ inputs-typesC) Computation)
+ (_.apply/* (~ runtime-nameC) (list (~+ inputsC)))))
+ (` (def: (~ code-nameC)
+ Statement
+ (..feature (~ runtime-nameC)
+ (function ((~ g!_) (~ g!_))
+ (..with-vars [(~+ inputsC)]
+ (_.function (~ g!_) (list (~+ inputsC))
+ (~ code)))))))))))))
+
+(runtime: (lux//try op)
+ (with-vars [ex]
+ (_.try (_.return (_.apply/1 op ..unit))
+ [ex (_.return (|> ex (_.do "toString" (list))))])))
+
+(def: length (_.the "length"))
+
+(runtime: (lux//program-args)
+ (with-vars [process output idx]
+ (_.if (_.and (_.not (_.= (_.type-of process)
+ _.undefined))
+ (|> process (_.the "argv")))
+ ($_ _.then
+ (_.define output ..none)
+ (_.for idx
+ (|> process (_.the "argv") ..length (_.- (_.i32 +1)))
+ (_.>= (_.i32 +0) idx)
+ (_.-- idx)
+ (_.set output (..some (_.array (list (|> process (_.the "argv") (_.at idx))
+ output)))))
+ (_.return output))
+ (_.return ..none))))
+
+(def: runtime//lux
+ Statement
+ ($_ _.then
+ @lux//try
+ @lux//program-args
+ ))
+
+(runtime: (product//left product index)
+ (with-vars [index-min-length]
+ ($_ _.then
+ (_.define index-min-length (_.+ (_.i32 +1) index))
+ (_.if (_.> index-min-length
+ (..length product))
+ ## No need for recursion.
+ (_.return (_.at index product))
+ ## Needs recursion.
+ (_.return (product//left (_.at (|> product ..length (_.- (_.i32 +1)))
+ product)
+ (_.- (..length product)
+ index-min-length)))
+ ))))
+
+(runtime: (product//right product index)
+ (with-vars [index-min-length]
+ ($_ _.then
+ (_.define index-min-length (_.+ (_.i32 +1) index))
+ (_.cond (list [(_.= index-min-length
+ (..length product))
+ ## Last element.
+ (_.return (_.at index product))]
+ [(_.< index-min-length
+ (..length product))
+ ## Needs recursion.
+ (_.return (product//right (_.at (|> product ..length (_.- (_.i32 +1)))
+ product)
+ (_.- (..length product)
+ index-min-length)))])
+ ## Must slice
+ (_.return (_.do "slice" (list index) product))))))
+
+(runtime: (sum//get sum wanted-tag wants-last)
+ (let [no-match! (_.return _.null)
+ sum-tag (|> sum (_.the ..variant-tag-field))
+ sum-flag (|> sum (_.the ..variant-flag-field))
+ sum-value (|> sum (_.the ..variant-value-field))
+ is-last? (_.= ..unit sum-flag)
+ extact-match! (_.return sum-value)
+ test-recursion! (_.if is-last?
+ ## Must recurse.
+ (_.return (sum//get sum-value (_.- sum-tag wanted-tag) wants-last))
+ no-match!)
+ extrac-sub-variant! (_.return (..variant (_.- wanted-tag sum-tag) sum-flag sum-value))]
+ (_.cond (list [(_.= wanted-tag sum-tag)
+ (_.if (_.= wants-last sum-flag)
+ extact-match!
+ test-recursion!)]
+ [(_.< wanted-tag sum-tag)
+ test-recursion!]
+ [(_.and (_.> wanted-tag sum-tag)
+ (_.= ..unit wants-last))
+ extrac-sub-variant!])
+ no-match!)))
+
+(def: runtime//structure
+ Statement
+ ($_ _.then
+ @product//left
+ @product//right
+ @sum//get
+ ))
+
+(def: #export i64-high-field Text "H")
+(def: #export i64-low-field Text "L")
+
+(runtime: (i64//new high low)
+ (_.return (_.object (list [..i64-high-field high]
+ [..i64-low-field low]))))
+
+(runtime: i64//2^16
+ (_.left-shift (_.i32 +16) (_.i32 +1)))
+
+(runtime: i64//2^32
+ (_.* i64//2^16 i64//2^16))
+
+(runtime: i64//2^64
+ (_.* i64//2^32 i64//2^32))
+
+(runtime: i64//2^63
+ (|> i64//2^64 (_./ (_.i32 +2))))
+
+(runtime: (i64//unsigned-low i64)
+ (_.return (_.? (|> i64 (_.the ..i64-low-field) (_.>= (_.i32 +0)))
+ (|> i64 (_.the ..i64-low-field))
+ (|> i64 (_.the ..i64-low-field) (_.+ i64//2^32)))))
+
+(runtime: (i64//to-number i64)
+ (_.return (|> i64 (_.the ..i64-high-field) (_.* i64//2^32)
+ (_.+ (i64//unsigned-low i64)))))
+
+(runtime: i64//zero
+ (i64//new (_.i32 +0) (_.i32 +0)))
+
+(runtime: i64//min
+ (i64//new (_.i32 (hex "+80000000")) (_.i32 +0)))
+
+(runtime: i64//max
+ (i64//new (_.i32 (hex "+7FFFFFFF")) (_.i32 (hex "+FFFFFFFF"))))
+
+(runtime: i64//one
+ (i64//new (_.i32 +0) (_.i32 +1)))
+
+(runtime: (i64//= left right)
+ (_.return (_.and (_.= (_.the ..i64-high-field left)
+ (_.the ..i64-high-field right))
+ (_.= (_.the ..i64-low-field left)
+ (_.the ..i64-low-field right)))))
+
+(runtime: (i64//+ left right)
+ (let [up-16 (_.left-shift (_.i32 +16))
+ high-16 (_.logic-right-shift (_.i32 +16))
+ low-16 (_.bit-and (_.i32 (hex "+FFFF")))
+ hh (|>> (_.the ..i64-high-field) high-16)
+ hl (|>> (_.the ..i64-high-field) low-16)
+ lh (|>> (_.the ..i64-low-field) high-16)
+ ll (|>> (_.the ..i64-low-field) low-16)]
+ (with-vars [l48 l32 l16 l00
+ r48 r32 r16 r00
+ x48 x32 x16 x00]
+ ($_ _.then
+ (_.define l48 (hh left))
+ (_.define l32 (hl left))
+ (_.define l16 (lh left))
+ (_.define l00 (ll left))
+
+ (_.define r48 (hh right))
+ (_.define r32 (hl right))
+ (_.define r16 (lh right))
+ (_.define r00 (ll right))
+
+ (_.define x00 (_.+ l00 r00))
+ (_.define x16 (high-16 x00))
+ (_.set x00 (low-16 x00))
+ (_.set x16 (|> x16 (_.+ l16) (_.+ r16)))
+ (_.define x32 (high-16 x16))
+ (_.set x16 (low-16 x16))
+ (_.set x32 (|> x32 (_.+ l32) (_.+ r32)))
+ (_.define x48 (|> (high-16 x32) (_.+ l48) (_.+ r48) low-16))
+ (_.set x32 (low-16 x32))
+
+ (_.return (i64//new (_.bit-or (up-16 x48) x32)
+ (_.bit-or (up-16 x16) x00)))
+ ))))
+
+(do-template [<name> <op>]
+ [(runtime: (<name> left right)
+ (_.return (i64//new (<op> (_.the ..i64-high-field left)
+ (_.the ..i64-high-field right))
+ (<op> (_.the ..i64-low-field left)
+ (_.the ..i64-low-field right)))))]
+
+ [i64//xor _.bit-xor]
+ [i64//or _.bit-or]
+ [i64//and _.bit-and]
+ )
+
+(runtime: (i64//not value)
+ (_.return (i64//new (_.bit-not (_.the ..i64-high-field value))
+ (_.bit-not (_.the ..i64-low-field value)))))
+
+(runtime: (i64//negate value)
+ (_.if (i64//= i64//min value)
+ (_.return i64//min)
+ (_.return (i64//+ (i64//not value) i64//one))))
+
+(runtime: i64//-one
+ (i64//negate i64//one))
+
+(runtime: (i64//from-number value)
+ (_.cond (list [(_.not-a-number? value)
+ (_.return i64//zero)]
+ [(_.<= (_.negate i64//2^63) value)
+ (_.return i64//min)]
+ [(|> value (_.+ (_.i32 +1)) (_.>= i64//2^63))
+ (_.return i64//max)]
+ [(|> value (_.< (_.i32 +0)))
+ (_.return (|> value _.negate i64//from-number i64//negate))])
+ (_.return (i64//new (_./ i64//2^32 value)
+ (_.% i64//2^32 value)))))
+
+(def: (cap-shift! shift)
+ (-> Var Statement)
+ (_.set shift (|> shift (_.bit-and (_.i32 +63)))))
+
+(def: (no-shift! shift input)
+ (-> Var Var [Expression Statement])
+ [(|> shift (_.= (_.i32 +0)))
+ (_.return input)])
+
+(def: small-shift?
+ (-> Var Expression)
+ (|>> (_.< (_.i32 +32))))
+
+(runtime: (i64//left-shift input shift)
+ ($_ _.then
+ (..cap-shift! shift)
+ (_.cond (list (..no-shift! shift input)
+ [(..small-shift? shift)
+ (let [high (_.bit-or (|> input (_.the ..i64-high-field) (_.left-shift shift))
+ (|> input (_.the ..i64-low-field) (_.logic-right-shift (_.- shift (_.i32 +32)))))
+ low (|> input (_.the ..i64-low-field) (_.left-shift shift))]
+ (_.return (i64//new high low)))])
+ (let [high (|> input (_.the ..i64-low-field) (_.left-shift (_.- (_.i32 +32) shift)))]
+ (_.return (i64//new high (_.i32 +0)))))))
+
+(runtime: (i64//arithmetic-right-shift input shift)
+ ($_ _.then
+ (..cap-shift! shift)
+ (_.cond (list (..no-shift! shift input)
+ [(..small-shift? shift)
+ (let [high (|> input (_.the ..i64-high-field) (_.arithmetic-right-shift shift))
+ low (|> input (_.the ..i64-low-field) (_.logic-right-shift shift)
+ (_.bit-or (|> input (_.the ..i64-high-field) (_.left-shift (_.- shift (_.i32 +32))))))]
+ (_.return (i64//new high low)))])
+ (let [high (_.? (|> input (_.the ..i64-high-field) (_.>= (_.i32 +0)))
+ (_.i32 +0)
+ (_.i32 -1))
+ low (|> input (_.the ..i64-high-field) (_.arithmetic-right-shift (_.- (_.i32 +32) shift)))]
+ (_.return (i64//new high low))))))
+
+(runtime: (i64//logic-right-shift input shift)
+ ($_ _.then
+ (..cap-shift! shift)
+ (_.cond (list (..no-shift! shift input)
+ [(..small-shift? shift)
+ (let [high (|> input (_.the ..i64-high-field) (_.logic-right-shift shift))
+ low (|> input (_.the ..i64-low-field) (_.logic-right-shift shift)
+ (_.bit-or (|> input (_.the ..i64-high-field) (_.left-shift (_.- shift (_.i32 +32))))))]
+ (_.return (i64//new high low)))]
+ [(|> shift (_.= (_.i32 +32)))
+ (_.return (i64//new (_.i32 +0) (|> input (_.the ..i64-high-field))))])
+ (_.return (i64//new (_.i32 +0)
+ (|> input (_.the ..i64-high-field) (_.logic-right-shift (_.- (_.i32 +32) shift))))))))
+
+(def: runtime//bit
+ Statement
+ ($_ _.then
+ @i64//and
+ @i64//or
+ @i64//xor
+ @i64//not
+ @i64//left-shift
+ @i64//arithmetic-right-shift
+ @i64//logic-right-shift
+ ))
+
+(runtime: (i64//- left right)
+ (_.return (i64//+ left (i64//negate right))))
+
+(runtime: (i64//* left right)
+ (let [negative? (|>> (_.the ..i64-high-field) (_.< (_.i32 +0)))]
+ (_.cond (list [(negative? left)
+ (_.if (negative? right)
+ ## Both are negative
+ (_.return (i64//* (i64//negate left) (i64//negate right)))
+ ## Left is negative
+ (_.return (i64//negate (i64//* (i64//negate left) right))))]
+ [(negative? right)
+ ## Right is negative
+ (_.return (i64//negate (i64//* left (i64//negate right))))])
+ ## Both are positive
+ (let [up-16 (_.left-shift (_.i32 +16))
+ high-16 (_.logic-right-shift (_.i32 +16))
+ low-16 (_.bit-and (_.i32 (hex "+FFFF")))
+ hh (|>> (_.the ..i64-high-field) high-16)
+ hl (|>> (_.the ..i64-high-field) low-16)
+ lh (|>> (_.the ..i64-low-field) high-16)
+ ll (|>> (_.the ..i64-low-field) low-16)]
+ (with-vars [l48 l32 l16 l00
+ r48 r32 r16 r00
+ x48 x32 x16 x00]
+ ($_ _.then
+ (_.define l48 (hh left))
+ (_.define l32 (hl left))
+ (_.define l16 (lh left))
+ (_.define l00 (ll left))
+
+ (_.define r48 (hh right))
+ (_.define r32 (hl right))
+ (_.define r16 (lh right))
+ (_.define r00 (ll right))
+
+ (_.define x00 (_.* l00 r00))
+ (_.define x16 (high-16 x00))
+ (_.set x00 (low-16 x00))
+
+ (_.set x16 (|> x16 (_.+ (_.* l16 r00))))
+ (_.define x32 (high-16 x16)) (_.set x16 (low-16 x16))
+ (_.set x16 (|> x16 (_.+ (_.* l00 r16))))
+ (_.set x32 (|> x32 (_.+ (high-16 x16)))) (_.set x16 (low-16 x16))
+
+ (_.set x32 (|> x32 (_.+ (_.* l32 r00))))
+ (_.define x48 (high-16 x32)) (_.set x32 (low-16 x32))
+ (_.set x32 (|> x32 (_.+ (_.* l16 r16))))
+ (_.set x48 (|> x48 (_.+ (high-16 x32)))) (_.set x32 (low-16 x32))
+ (_.set x32 (|> x32 (_.+ (_.* l00 r32))))
+ (_.set x48 (|> x48 (_.+ (high-16 x32)))) (_.set x32 (low-16 x32))
+
+ (_.set x48 (|> x48
+ (_.+ (_.* l48 r00))
+ (_.+ (_.* l32 r16))
+ (_.+ (_.* l16 r32))
+ (_.+ (_.* l00 r48))
+ low-16))
+
+ (_.return (i64//new (_.bit-or (up-16 x48) x32)
+ (_.bit-or (up-16 x16) x00)))
+ ))))))
+
+(runtime: (i64//< left right)
+ (let [negative? (|>> (_.the ..i64-high-field) (_.< (_.i32 +0)))]
+ (with-vars [-left? -right?]
+ ($_ _.then
+ (_.define -left? (negative? left))
+ (_.define -right? (negative? right))
+ (_.cond (list [(_.and -left? (_.not right))
+ (_.return _.true)]
+ [(_.and (_.not -left?) right)
+ (_.return _.false)])
+ (_.return (negative? (i64//- left right))))))))
+
+(def: (i64//<= subject param)
+ (-> Expression Expression Expression)
+ (_.or (i64//< subject param)
+ (i64//= subject param)))
+
+(runtime: (i64/// subject parameter)
+ (let [negative? (function (_ value)
+ (i64//< value i64//zero))
+ valid-division-check [(i64//= i64//zero parameter)
+ (_.throw (_.string "Cannot divide by zero!"))]
+ short-circuit-check [(i64//= i64//zero subject)
+ (_.return i64//zero)]]
+ (_.cond (list valid-division-check
+ short-circuit-check
+
+ [(i64//= i64//min subject)
+ (_.cond (list [(_.or (i64//= i64//one parameter)
+ (i64//= i64//-one parameter))
+ (_.return i64//min)]
+ [(i64//= i64//min parameter)
+ (_.return i64//one)])
+ (with-vars [approximation]
+ ($_ _.then
+ (_.define approximation (i64//left-shift (i64/// (i64//arithmetic-right-shift subject (_.i32 +1))
+ parameter)
+ (_.i32 +1)))
+ (_.if (i64//= i64//zero approximation)
+ (_.return (_.? (negative? parameter)
+ i64//one
+ i64//-one))
+ (let [remainder (i64//- subject
+ (i64//* parameter
+ approximation))
+ result (i64//+ approximation
+ (i64/// remainder
+ parameter))]
+ (_.return result))))))]
+ [(i64//= i64//min parameter)
+ (_.return i64//zero)]
+
+ [(negative? subject)
+ (_.return (_.? (negative? parameter)
+ (i64/// (i64//negate subject)
+ (i64//negate parameter))
+ (i64//negate (i64/// (i64//negate subject)
+ parameter))))]
+
+ [(negative? parameter)
+ (_.return (i64//negate (i64/// subject (i64//negate parameter))))])
+ (with-vars [result remainder]
+ ($_ _.then
+ (_.define result i64//zero)
+ (_.define remainder subject)
+ (_.while (i64//<= remainder parameter)
+ (with-vars [approximate approximate-result approximate-remainder log2 delta]
+ (let [rough-estimate (|> (i64//to-number remainder)
+ (_./ (i64//to-number parameter))
+ (_.apply/1 (_.var "Math.floor")))
+ approximate-result' (i64//from-number approximate)
+ approx-remainder (i64//* approximate-result parameter)]
+ ($_ _.then
+ (_.define approximate (_.apply/2 (_.var "Math.max") (_.i32 +1) rough-estimate))
+ (_.define log2 (|> approximate
+ (_.apply/1 (_.var "Math.log"))
+ (_./ (_.var "Math.LN2"))
+ (_.apply/1 (_.var "Math.ceil"))))
+ (_.define delta (_.? (_.<= (_.i32 +48) log2)
+ (_.i32 +1)
+ (_.apply/2 (_.var "Math.pow")
+ (_.i32 +2)
+ (_.- (_.i32 +48)
+ log2))))
+ (_.define approximate-result approximate-result')
+ (_.define approximate-remainder approx-remainder)
+ (_.while (_.or (negative? approximate-remainder)
+ (i64//< remainder
+ approximate-remainder))
+ ($_ _.then
+ (_.set approximate (_.- delta approximate))
+ (_.set approximate-result approximate-result')
+ (_.set approximate-remainder approx-remainder)))
+ (_.set result (i64//+ result
+ (_.? (i64//= i64//zero approximate-result)
+ i64//one
+ approximate-result)))
+ (_.set remainder (i64//- remainder approximate-remainder))))))
+ (_.return result)))
+ )))
+
+(runtime: (i64//% subject parameter)
+ (let [flat (i64//* (i64/// subject parameter)
+ parameter)]
+ (_.return (i64//- subject flat))))
+
+(def: runtime//i64
+ Statement
+ ($_ _.then
+ @i64//2^16
+ @i64//2^32
+ @i64//2^64
+ @i64//2^63
+ @i64//unsigned-low
+ @i64//zero
+ @i64//new
+ @i64//min
+ @i64//max
+ @i64//one
+ @i64//=
+ @i64//+
+ @i64//negate
+ @i64//to-number
+ @i64//from-number
+ @i64//-
+ @i64//*
+ @i64//<
+ @i64///
+ @i64//%
+ runtime//bit
+ ))
+
+(runtime: (text//index text part start)
+ (with-vars [idx]
+ ($_ _.then
+ (_.define idx (|> text (_.do "indexOf" (list part (i64//to-number start)))))
+ (_.if (_.= (_.i32 -1) idx)
+ (_.return ..none)
+ (_.return (..some (i64//from-number idx)))))))
+
+(runtime: (text//clip text start end)
+ (let [out-of-bounds? (|>> (_.the ..i64-low-field) (_.> (..length text)))]
+ (_.if (_.or (out-of-bounds? start)
+ (out-of-bounds? end))
+ (_.return ..none)
+ (_.return (..some (|> text (_.do "substring" (list (_.the ..i64-low-field start)
+ (_.the ..i64-low-field end)))))))))
+
+(runtime: (text//char text idx)
+ (with-vars [result]
+ ($_ _.then
+ (_.define result (|> text (_.do "charCodeAt" (list (_.the ..i64-low-field idx)))))
+ (_.if (_.not-a-number? result)
+ (_.return ..none)
+ (_.return (..some (i64//from-number result)))))))
+
+(def: runtime//text
+ Statement
+ ($_ _.then
+ @text//index
+ @text//clip
+ @text//char
+ ))
+
+(runtime: (io//log message)
+ (with-vars [console print]
+ (let [end! (_.return ..unit)]
+ (_.cond (list [(|> console _.type-of (_.= _.undefined) _.not
+ (_.and (_.the "log" console)))
+ ($_ _.then
+ (_.statement (|> console (_.do "log" (list message))))
+ end!)]
+ [(|> print _.type-of (_.= _.undefined) _.not)
+ ($_ _.then
+ (_.statement (_.apply/1 print message))
+ end!)])
+ end!))))
+
+(runtime: (io//error message)
+ (_.throw message))
+
+(def: runtime//io
+ Statement
+ ($_ _.then
+ @io//log
+ @io//error
+ ))
+
+(runtime: (js//get object field)
+ (with-vars [temp]
+ (_.if (|> temp (_.= _.undefined) _.not)
+ (_.return (..some temp))
+ (_.return ..none))))
+
+(runtime: (js//set object field input)
+ ($_ _.then
+ (_.set (_.at field object) input)
+ (_.return object)))
+
+(runtime: (js//delete object field)
+ ($_ _.then
+ (_.delete (_.at field object))
+ (_.return object)))
+
+(runtime: (js//call object method inputs)
+ (_.return (_.apply/2 (_.at method object) object inputs)))
+
+(def: runtime//js
+ Statement
+ ($_ _.then
+ @js//get
+ @js//set
+ @js//delete
+ @js//call
+ ))
+
+(def: runtime
+ Statement
+ ($_ _.then
+ runtime//lux
+ runtime//structure
+ runtime//i64
+ runtime//text
+ runtime//io
+ runtime//js
+ ))
+
+(def: #export artifact Text (format prefix ".js"))
+
+(def: #export translate
+ (Operation Any)
+ (///.with-buffer
+ (do ////.monad
+ [_ (///.save! ["" ..prefix] ..runtime)]
+ (///.save-buffer! ..artifact))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux
new file mode 100644
index 000000000..4949ddacf
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux
@@ -0,0 +1,32 @@
+(.module:
+ [lux #*
+ [control
+ ["." monad (#+ do)]]
+ [host
+ ["_" js (#+ Expression)]]]
+ [//
+ ["//." runtime (#+ Generator)]
+ ["//." primitive]
+ ["//." ///
+ [analysis (#+ Variant Tuple)]
+ ["." synthesis (#+ Synthesis)]]])
+
+(def: #export (tuple elemsS+ translate)
+ (Generator (Tuple Synthesis))
+ (case elemsS+
+ #.Nil
+ (//primitive.text synthesis.unit)
+
+ (#.Cons singletonS #.Nil)
+ (translate singletonS)
+
+ _
+ (do /////.monad
+ [elemsT+ (monad.map @ translate elemsS+)]
+ (wrap (_.array elemsT+)))))
+
+(def: #export (variant [lefts right? valueS] translate)
+ (Generator (Variant Synthesis))
+ (do /////.monad
+ [valueT (translate valueS)]
+ (wrap (//runtime.variant (_.i32 (.int lefts)) (//runtime.flag right?) valueT))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux
index dc643bcbc..86bf44c0f 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux
@@ -1,25 +1,19 @@
(.module:
- [lux (#- i64)]
+ [lux (#- i64)
+ [host
+ ["_" scheme (#+ Expression)]]]
[//
[runtime (#+ Operation)]
- [// (#+ State)
- ["//." // ("#/." monad)
- [///
- [host
- ["_" scheme (#+ Expression)]]]]]])
+ [//
+ ["//." // ("#/." monad)]]])
-(def: #export bit
- (-> Bit (Operation Expression))
- (|>> _.bool /////wrap))
+(do-template [<name> <type> <code>]
+ [(def: #export <name>
+ (-> <type> (Operation Expression))
+ (|>> <code> /////wrap))]
-(def: #export i64
- (-> (I64 Any) (Operation Expression))
- (|>> .int _.int /////wrap))
-
-(def: #export f64
- (-> Frac (Operation Expression))
- (|>> _.float /////wrap))
-
-(def: #export text
- (-> Text (Operation Expression))
- (|>> _.string /////wrap))
+ [bit Bit _.bool]
+ [i64 Int _.int]
+ [f64 Frac _.float]
+ [text Text _.string]
+ )
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux
index 161d2adea..b28cb1898 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux
@@ -1,48 +1,12 @@
(.module:
[lux #*
- [control
- pipe]
- [data
- [text
- format]]]
+ [host
+ ["_" scheme (#+ Expression)]]]
[//
- [runtime (#+ Operation)]
- ["/." //
- ["//." // ("#/." monad)
- [analysis (#+ Variant Tuple)]
- [synthesis (#+ Synthesis)]
- [//
- ["." reference (#+ Register Variable Reference)]
- [//
- [host
- ["_" scheme (#+ Expression Global Var)]]]]]]])
+ [//
+ [common
+ ["." reference]]]])
-(do-template [<name> <prefix>]
- [(def: #export <name>
- (-> Register Var)
- (|>> .int %i (format <prefix>) _.var))]
-
- [local' "l"]
- [foreign' "f"]
- )
-
-(def: #export variable
- (-> Variable (Operation Var))
- (|>> (case> (#reference.Local register)
- (local' register)
-
- (#reference.Foreign register)
- (foreign' register))
- /////wrap))
-
-(def: #export constant
- (-> Name (Operation Global))
- (|>> ///.remember (/////map _.global)))
-
-(def: #export reference
- (-> Reference (Operation Expression))
- (|>> (case> (#reference.Constant value)
- (..constant value)
-
- (#reference.Variable value)
- (..variable value))))
+(def: #export system
+ (reference.system (: (-> Text Expression) _.global)
+ (: (-> Text Expression) _.var)))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux
index d254e8c7d..904f40726 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux
@@ -1,5 +1,6 @@
(.module:
[lux #*
+ ["." function]
[control
["p" parser ("#/." monad)]
[monad (#+ do)]]
@@ -9,19 +10,17 @@
format]
[collection
["." list ("#/." monad)]]]
- ["." function]
[macro
["." code]
- ["s" syntax (#+ syntax:)]]]
+ ["s" syntax (#+ syntax:)]]
+ [host
+ ["_" scheme (#+ Expression Computation Var)]]]
["." ///
["//." //
[analysis (#+ Variant)]
["." synthesis]
[//
- ["." name]
- [//
- [host
- ["_" scheme (#+ Expression Computation Var)]]]]]])
+ ["." name]]]])
(do-template [<name> <base>]
[(type: #export <name>
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux
index dc1b88591..aa4742fb1 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux
@@ -1,16 +1,15 @@
(.module:
[lux #*
[control
- ["." monad (#+ do)]]]
+ ["." monad (#+ do)]]
+ [host
+ ["_" scheme (#+ Expression)]]]
[//
["." runtime (#+ Operation Phase)]
["." primitive]
["." ///
[analysis (#+ Variant Tuple)]
- ["." synthesis (#+ Synthesis)]
- [///
- [host
- ["_" scheme (#+ Expression)]]]]])
+ ["." synthesis (#+ Synthesis)]]])
(def: #export (tuple translate elemsS+)
(-> Phase (Tuple Synthesis) (Operation Expression))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-12 15:59:22 +0000