aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux330
1 files changed, 0 insertions, 330 deletions
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<Parser>]
- [monad #+ do])
- (data text/format
- (coll [list "list/" Monad<List>]))
- [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 [<name> <top-cmp>]
-## [(def: (<name> top value)
-## (-> Expression Expression Expression)
-## (_.and (|> value (_.>= (_.int 0)))
-## (|> value (<top-cmp> 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<Meta>
- [_ //.init-module-buffer
- _ (//.save runtime)]
- (//.save-module! artifact)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 03:10:30 +0000