From f2c0473640e8029f27797f6ecf21662dddb0685b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 24 Apr 2019 21:28:56 -0400 Subject: WIP: PHP compiler. --- .../luxc/lang/translation/php/runtime.jvm.lux | 330 --------------------- 1 file changed, 330 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux (limited to 'new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux') diff --git a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux deleted file mode 100644 index 7c4d9f444..000000000 --- a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux +++ /dev/null @@ -1,330 +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 ["_" php #+ Expression Computation Statement])))) - -(def: prefix Text "LuxRuntime") - -(def: #export unit Computation (_.string //.unit)) - -(def: (flag value) - (-> Bit Computation) - (if value - (_.string "") - _.null)) - -(def: (variant' tag last? value) - (-> Expression Expression Expression Computation) - (_.array/** (list [(_.string //.variant-tag-field) tag] - [(_.string //.variant-flag-field) last?] - [(_.string //.variant-value-field) value]))) - -(def: #export (variant tag last? value) - (-> Nat Bit Expression Computation) - (variant' (_.int (.int tag)) - (flag last?) - value)) - -(def: #export none - Computation - (variant +0 #0 unit)) - -(def: #export some - (-> Expression Computation) - (variant +1 #1)) - -(def: #export left - (-> Expression Computation) - (variant +0 #0)) - -(def: #export right - (-> Expression Computation) - (variant +1 #1)) - -(type: Runtime Statement) - -(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 (format "__" prefix "__" (lang.normalize-name name)) - @runtime (` (_.global (~ (code.text runtime)))) - argsC+ (list/map code.local-identifier args) - argsLC+ (list/map (|>> lang.normalize-name code.text (~) (_.var) (`)) - args) - declaration (` ((~ (code.local-identifier name)) - (~+ argsC+))) - type (` (-> (~+ (list.repeat (list.size argsC+) (` _.Expression))) - _.Computation))] - (wrap (list (` (def: (~' #export) (~ declaration) - (~ type) - (_.apply (list (~+ argsC+)) (~ @runtime)))) - (` (def: (~ implementation) - _.Statement - (~ (case argsC+ - #.Nil - (` (_.define! (~ @runtime) (~ definition))) - - _ - (` (let [(~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function (_ [left right]) - (list left right))) - list/join))] - (_.function! (~ @runtime) - ((~! list/map) _.parameter (list (~+ argsLC+))) - (~ definition)))))))))))) - -(syntax: (with-vars {vars (s.tuple (p.many s.local-identifier))} - body) - (wrap (list (` (let [(~+ (|> vars - (list/map (function (_ var) - (list (code.local-identifier var) - (` (_.var (~ (code.text (lang.normalize-name var)))))))) - list/join))] - (~ body)))))) - -## (runtime: (lux//try op) -## (let [$error (_.var "error") -## $value (_.var "value")] -## (_.try! ($_ _.then! -## (_.set! (list $value) (_.apply (list unit) op)) -## (_.return! (right (@@ $value)))) -## (list [(list "Exception") $error -## (_.return! (left (_.apply (list (@@ $error)) (_.global "str"))))])))) - -## (runtime: (lux//program-args program-args) -## (let [$inputs (_.var "inputs") -## $value (_.var "value")] -## ($_ _.then! -## (_.set! (list $inputs) none) -## (<| (_.for-in! $value program-args) -## (_.set! (list $inputs) -## (some (_.tuple (list (@@ $value) (@@ $inputs)))))) -## (_.return! (@@ $inputs))))) - -## (def: runtime//lux -## Runtime -## ($_ _.then! -## @@lux//try -## @@lux//program-args)) - -## (runtime: (io//log! message) -## ($_ _.then! -## (_.print! message) -## (_.return! ..unit))) - -## (def: (exception message) -## (-> Expression Computation) -## (_.apply (list message) (_.global "Exception"))) - -## (runtime: (io//throw! message) -## ($_ _.then! -## (_.raise! (exception message)) -## (_.return! ..unit))) - -## (runtime: (io//exit! code) -## ($_ _.then! -## (_.import! "sys") -## (_.do! (|> (_.global "sys") (_.send (list code) "exit"))) -## (_.return! ..unit))) - -## (runtime: (io//current-time! _) -## ($_ _.then! -## (_.import! "time") -## (_.return! (let [time (|> (_.global "time") -## (_.send (list) "time") -## (_.* (_.int 1,000)))] -## (_.apply (list time) (_.global "int")))))) - -## (def: runtime//io -## Runtime -## ($_ _.then! -## @@io//log! -## @@io//throw! -## @@io//exit! -## @@io//current-time!)) - -(runtime: (product//left product index) - (let [$index_min_length (_.var "index_min_length")] - (|> (_.set! $index_min_length (_.+ (_.int 1) index)) - (_.then! (_.if! (_.> $index_min_length (_.count/1 product)) - ## No need for recursion - (_.return! (_.nth index product)) - ## Needs recursion - (_.return! (product//left (_.nth (_.- (_.int 1) - (_.count/1 product)) - product) - (_.- (_.count/1 product) - $index_min_length)))))))) - -(runtime: (product//right product index) - (let [$index_min_length (_.var "index_min_length")] - (|> (_.set! $index_min_length (_.+ (_.int 1) index)) - (_.then! (<| (_.if! (_.= $index_min_length (_.count/1 product)) - ## Last element. - (_.return! (_.nth index product))) - (_.if! (_.< $index_min_length (_.count/1 product)) - ## Needs recursion - (_.return! (product//right (_.nth (_.- (_.int 1) - (_.count/1 product)) - product) - (_.- (_.count/1 product) - $index_min_length)))) - ## Must slice - (_.return! (_.array-slice/2 product index))))))) - -(runtime: (sum//get sum wantedTag wantsLast) - (let [no-match! (_.return! _.null) - sum-tag (_.nth (_.string //.variant-tag-field) sum) - sum-flag (_.nth (_.string //.variant-flag-field) sum) - sum-value (_.nth (_.string //.variant-value-field) sum) - is-last? (_.= (_.string "") sum-flag) - test-recursion! (_.if! is-last? - ## Must recurse. - (_.return! (sum//get sum-value (_.- sum-tag wantedTag) wantsLast)) - no-match!)] - (<| (_.if! (_.= sum-tag wantedTag) - (_.if! (|> (_.and (_.is-null/1 wantsLast) (_.is-null/1 sum-flag)) - (_.or (|> (_.and (_.not (_.is-null/1 wantsLast)) - (_.not (_.is-null/1 sum-flag))) - (_.and (_.= wantsLast sum-flag))))) - (_.return! sum-value) - test-recursion!)) - (_.if! (_.> sum-tag wantedTag) - test-recursion!) - (_.if! (|> (_.< sum-tag wantedTag) - (_.and (_.not (_.is-null/1 wantsLast)))) - (_.return! (variant' (_.- wantedTag sum-tag) sum-flag sum-value))) - no-match!))) - -(def: runtime//adt - Runtime - (|> @@product//left - (_.then! @@product//right) - (_.then! @@sum//get))) - -## (runtime: (bit//logical-right-shift param subject) -## (let [mask (|> (_.int 1) -## (_.bit-shl (_.- param (_.int 64))) -## (_.- (_.int 1)))] -## (_.return! (|> subject -## (_.bit-shr param) -## (_.bit-and mask))))) - -## (def: runtime//bit -## Runtime -## ($_ _.then! -## @@bit//logical-right-shift)) - -## (runtime: (text//index subject param start) -## (with-vars [idx] -## ($_ _.then! -## (_.set! (list idx) (_.send (list param start) "find" subject)) -## (_.if! (_.= (_.int -1) (@@ idx)) -## (_.return! ..none) -## (_.return! (..some (@@ idx))))))) - -## (def: inc (|>> (_.+ (_.int 1)))) - -## (template [ ] -## [(def: ( top value) -## (-> Expression Expression Expression) -## (_.and (|> value (_.>= (_.int 0))) -## (|> value ( top))))] - -## [within? _.<] -## [up-to? _.<=] -## ) - -## (runtime: (text//clip @text @from @to) -## (with-vars [length] -## ($_ _.then! -## (_.set! (list length) (_.count/1 @text)) -## (_.if! ($_ _.and -## (|> @to (within? (@@ length))) -## (|> @from (up-to? @to))) -## (_.return! (..some (|> @text (_.slice @from (inc @to))))) -## (_.return! ..none))))) - -## (runtime: (text//char text idx) -## (_.if! (|> idx (within? (_.count/1 text))) -## (_.return! (..some (_.apply (list (|> text (_.slice idx (inc idx)))) -## (_.global "ord")))) -## (_.return! ..none))) - -## (def: runtime//text -## Runtime -## ($_ _.then! -## @@text//index -## @@text//clip -## @@text//char)) - -## (def: (check-index-out-of-bounds array idx body!) -## (-> Expression Expression Statement Statement) -## (_.if! (|> idx (_.<= (_.count/1 array))) -## body! -## (_.raise! (exception (_.string "Array index out of bounds!"))))) - -## (runtime: (array//get array idx) -## (with-vars [temp] -## (<| (check-index-out-of-bounds array idx) -## ($_ _.then! -## (_.set! (list temp) (_.nth idx array)) -## (_.if! (_.= _.null (@@ temp)) -## (_.return! ..none) -## (_.return! (..some (@@ temp)))))))) - -## (runtime: (array//put array idx value) -## (<| (check-index-out-of-bounds array idx) -## ($_ _.then! -## (_.set-nth! idx value array) -## (_.return! array)))) - -## (def: runtime//array -## Runtime -## ($_ _.then! -## @@array//get -## @@array//put)) - -(def: check-necessary-conditions! - Statement - (let [condition (_.= (_.int 8) - (_.global "PHP_INT_SIZE")) - error-message (_.string (format "Cannot run program!" "\n" - "Lux/PHP programs require 64-bit PHP builds!")) - ->Exception (|>> (list) (_.new (_.global "Exception")))] - (_.when! (_.not condition) - (_.throw! (->Exception error-message))))) - -(def: runtime - Runtime - (|> check-necessary-conditions! - ## runtime//lux - (_.then! runtime//adt) - ## runtime//bit - ## runtime//text - ## runtime//array - ## runtime//io - )) - -(def: #export artifact Text (format prefix //.extension)) - -(def: #export translate - (Meta (Process Any)) - (do macro.Monad - [_ //.init-module-buffer - _ (//.save runtime)] - (//.save-module! artifact))) -- cgit v1.2.3