From f2937706edb6887c5eb1a6a0b6668b1334f5ef3b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 11 Apr 2019 22:30:05 -0400 Subject: WIP: Lua compiler. --- .../luxc/lang/translation/lua/runtime.jvm.lux | 293 --------------------- 1 file changed, 293 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux (limited to 'new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux') diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux deleted file mode 100644 index ce9c37db5..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ /dev/null @@ -1,293 +0,0 @@ -(.module: - lux - (lux (control ["p" parser "p/" Monad] - [monad #+ do]) - (data text/format - (coll [list "list/" Monad])) - [macro] - (macro [code] - ["s" syntax #+ syntax:]) - [io #+ Process]) - [//] - (luxc [lang] - (lang (host [lua #+ Lua Expression Statement])))) - -(def: prefix Text "LuxRuntime") - -(def: #export unit Expression (%t //.unit)) - -(def: (flag value) - (-> Bit Lua) - (if value - (lua.string "") - lua.nil)) - -(def: (variant' tag last? value) - (-> Expression Expression Expression Expression) - (lua.table (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 Lua) - -(def: declaration - (s.Syntax [Text (List Text)]) - (p.either (p.seq s.local-identifier (p/wrap (list))) - (s.form (p.seq s.local-identifier (p.some s.local-identifier))))) - -(syntax: (runtime: {[name args] declaration} - definition) - (let [implementation (code.local-identifier (format "@@" name)) - runtime (code.text (format "__" prefix "__" (lang.normalize-name name))) - argsC+ (list/map code.local-identifier args) - argsLC+ (list/map (|>> lang.normalize-name code.text) args) - declaration (` ((~ (code.local-identifier name)) - (~+ argsC+))) - type (` (-> (~+ (list.repeat (list.size argsC+) (` lua.Lua))) - lua.Lua))] - (wrap (list (` (def: #export (~ declaration) - (~ type) - (lua.apply (~ runtime) (list (~+ argsC+))))) - (` (def: (~ implementation) - Lua - (~ (case argsC+ - #.Nil - (` (lua.global! (~ runtime) (#.Some (~ definition)))) - - _ - (` (let [(~' @) (~ runtime) - (~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function (_ [left right]) (list left right))) - list/join))] - (lua.function! (~ runtime) (list (~+ argsLC+)) - (~ definition)))))))))))) - -(runtime: (array//copy array) - (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list)))) - (lua.for-step! "idx" (lua.int 1) (lua.length array) (lua.int 1) - (lua.apply "table.insert" (list "temp" (lua.nth "idx" array)))) - (lua.return! "temp")))) - -(runtime: (array//sub array from to) - (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list)))) - (lua.for-step! "idx" from to (lua.int 1) - (lua.apply "table.insert" (list "temp" (lua.nth "idx" array)))) - (lua.return! "temp")))) - -(runtime: (array//concat left right) - (let [copy! (function (_ input output) - (lua.for-step! "idx" (lua.int 1) (format input ".n") (lua.int 1) - (lua.apply "table.insert" (list output (lua.nth "idx" input)))))] - (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list)))) - (copy! left "temp") - (copy! right "temp") - (lua.return! "temp"))))) - -(runtime: (lux//try op) - (lua.block! (list (format "local success, value = " (lua.apply "pcall" (list (lua.function (list) (lua.return! (lua.apply op (list unit)))))) ";") - (lua.if! "success" - (lua.return! (right "value")) - (lua.return! (left "value")))))) - -(runtime: (lux//program-args program-args) - (lua.block! (list (lua.local! "inputs" (#.Some none)) - (lua.for-step! "idx" (lua.length program-args) (lua.int 1) (lua.int -1) - (lua.set! "inputs" (some (lua.array (list (lua.nth "idx" program-args) - "inputs"))))) - (lua.return! "inputs")))) - -(def: runtime//lux - Runtime - (format @@lux//try - @@lux//program-args)) - -(runtime: (product//left product index) - (lua.block! (list (lua.local! "index_min_length" (#.Some (lua.+ (lua.int 1) index))) - (lua.if! (lua.>= "index_min_length" (lua.length product)) - ## No need for recursion - (lua.return! (lua.nth "index_min_length" product)) - ## Needs recursion - (lua.return! (product//left (lua.nth (lua.length product) - product) - (lua.- (lua.length product) - "index_min_length"))))))) - -(runtime: (product//right product index) - (lua.block! (list (lua.local! "index_min_length" (#.Some (lua.+ (lua.int 1) index))) - (lua.cond! (list [(lua.= "index_min_length" (lua.length product)) - ## Last element. - (lua.return! (lua.nth "index_min_length" product))] - [(lua.< "index_min_length" (lua.length product)) - ## Needs recursion - (lua.return! (product//right (lua.nth (lua.length product) - product) - (lua.- (lua.length product) - "index_min_length")))]) - ## Must slice - (lua.return! (array//sub product "index_min_length" (lua.length product))))))) - -(runtime: (sum//get sum wantedTag wantsLast) - (let [no-match! (lua.return! lua.nil) - sum-tag (format "sum." //.variant-tag-field) - sum-flag (format "sum." //.variant-flag-field) - sum-value (format "sum." //.variant-value-field) - is-last? (lua.= (lua.string "") sum-flag) - test-recursion! (lua.if! is-last? - ## Must recurse. - (lua.return! (sum//get sum-value (lua.- sum-tag wantedTag) wantsLast)) - no-match!)] - (lua.cond! (list [(lua.= sum-tag wantedTag) - (lua.if! (lua.= wantsLast sum-flag) - (lua.return! sum-value) - test-recursion!)] - - [(lua.> sum-tag wantedTag) - test-recursion!] - - [(lua.and (lua.< sum-tag wantedTag) - (lua.= (lua.string "") wantsLast)) - (lua.return! (variant' (lua.- wantedTag sum-tag) sum-flag sum-value))]) - - no-match!))) - -(def: runtime//adt - Runtime - (format @@product//left - @@product//right - @@sum//get)) - -(runtime: (bit//logical-right-shift param subject) - (let [mask (|> (lua.int 1) - (lua.bit-shl (lua.- param (lua.int 64))) - (lua.- (lua.int 1)))] - (lua.return! (|> subject - (lua.bit-shr param) - (lua.bit-and mask))))) - -(def: runtime//bit - Runtime - @@bit//logical-right-shift) - -(runtime: (text//index subject param start) - (lua.block! (list (lua.local! "idx" (#.Some (lua.apply "string.find" (list subject param start (lua.bool #1))))) - (lua.if! (lua.= lua.nil "idx") - (lua.return! none) - (lua.return! (some "idx")))))) - -(runtime: (text//clip text from to) - (lua.block! (list (lua.local! "size" (#.Some (lua.apply "string.len" (list text)))) - (lua.if! (lua.or (lua.> "size" from) - (lua.> "size" to)) - (lua.return! none) - (lua.return! (some (lua.apply "string.sub" (list text from to)))))))) - -(runtime: (text//char text idx) - (lua.block! (list (lua.local! "char" (#.Some (lua.apply "string.byte" (list text idx)))) - (lua.if! (lua.= lua.nil "char") - (lua.return! none) - (lua.return! (some "char")))))) - -(def: runtime//text - Runtime - (format @@text//index - @@text//clip - @@text//char)) - -(def: (check-index-out-of-bounds array idx body!) - (-> Expression Expression Statement Statement) - (lua.if! (lua.<= (lua.length array) - idx) - body! - (lua.error (lua.string "Array index out of bounds!")))) - -(runtime: (array//new size) - (lua.block! (list (lua.local! "output" (#.Some (lua.array (list)))) - (lua.for-step! "idx" (lua.int 1) size (lua.int 1) - (lua.apply "table.insert" (list "output" unit))) - (lua.return! "output")))) - -(runtime: (array//get array idx) - (<| (check-index-out-of-bounds array idx) - (lua.block! (list (lua.local! "temp" (#.Some (lua.nth idx array))) - (lua.if! (lua.or (lua.= lua.nil "temp") - (lua.= unit "temp")) - (lua.return! none) - (lua.return! (some "temp"))))))) - -(runtime: (array//put array idx value) - (<| (check-index-out-of-bounds array idx) - (lua.block! (list (lua.set! (lua.nth idx array) value) - (lua.return! array))))) - -(def: runtime//array - Runtime - (format @@array//sub - @@array//concat - @@array//copy - @@array//new - @@array//get - @@array//put - )) - -(runtime: (box//write value box) - (lua.block! (list (lua.set! (lua.nth (lua.int 0) box) - value) - (lua.return! unit)))) - -(def: runtime//box - Runtime - (format @@box//write)) - -(runtime: (lua//get object field) - (lua.block! (list (lua.local! "value" (#.Some (lua.nth field object))) - (lua.if! (lua.= lua.nil "value") - (lua.return! none) - (lua.return! (some "value")))))) - -(runtime: (lua//set object field value) - (lua.block! (list (lua.set! (lua.nth field object) value) - (lua.return! object)))) - -(def: runtime//lua - Runtime - (format @@lua//get - @@lua//set)) - -(def: runtime - Runtime - (format runtime//lux - runtime//adt - runtime//bit - runtime//text - runtime//array - runtime//box - runtime//lua)) - -(def: #export artifact Text (format prefix ".lua")) - -(def: #export translate - (Meta (Process Any)) - (do macro.Monad - [_ //.init-module-buffer - _ (//.save runtime)] - (//.save-module! artifact))) -- cgit v1.2.3