(.module: lux (lux (control [monad #+ do] pipe) (data [product] [text] text/format (coll [list "list/" Functor Fold])) [macro]) (luxc ["&" lang] (lang ["ls" synthesis #+ Synthesis Arity] [".L" variable #+ Register Variable] (host ["_" php #+ Expression Var Computation Statement]))) [//] (// [".T" reference])) (def: #export (translate-apply translate functionS argsS+) (-> //.Translator Synthesis (List Synthesis) (Meta Computation)) (do macro.Monad [functionO (translate functionS) argsO+ (monad.map @ translate argsS+)] (wrap (_.apply argsO+ functionO)))) (def: @curried (_.var "curried")) (def: (input-declaration! register) (-> Register Statement) (_.set! (referenceT.variable (inc register)) (_.nth (|> register .int _.int) @curried))) (def: (with-closure function-name inits function-definition!) (-> Text (List Expression) (-> (List Var) Statement) (Meta Expression)) (let [@function (_.var function-name)] (case inits #.Nil (do macro.Monad [_ (//.save (function-definition! (list)))] (wrap @function)) _ (do macro.Monad [#let [closure-name (format function-name "___CLOSURE") @closure (_.global (format function-name "___CLOSURE")) captured (|> (list.enumerate inits) (list/map (|>> product.left referenceT.closure)))] _ (//.save (_.function! @closure (list/map _.parameter captured) (|> (function-definition! captured) (_.then! (_.return! @function)))))] (wrap (_.apply inits @closure)))))) (def: #export (translate-function translate env arity bodyS) (-> //.Translator (List Variable) Arity Synthesis (Meta Expression)) (do macro.Monad [[base-function-name bodyO] (//.with-sub-context (do @ [function-name //.context] (//.with-anchor [function-name +1] (translate bodyS)))) current-module-name macro.current-module-name #let [function-name (format current-module-name "___" base-function-name)] closureO+ (monad.map @ referenceT.translate-variable env) #let [@function (_.var function-name) self-init! (_.set! (referenceT.variable +0) @function) args-inits! (|> (list.n/range +0 (dec arity)) (list/map input-declaration!) (list/fold _.then! self-init!)) arityO (|> arity .int _.int) @num_args (_.var "num_args")]] (with-closure function-name closureO+ (function (_ captured) (_.set! @function (_.function (list) (|> captured (list/map _.reference) (list& (_.reference @function))) (|> (_.set! @num_args _.func-num-args/0) (_.then! (_.set! @curried _.func-get-args/0)) (_.then! (_.if! (|> @num_args (_.= arityO)) (|> args-inits! (_.then! (_.return! bodyO))) (_.if! (|> @num_args (_.> arityO)) (let [arity-args (_.array-slice/3 @curried (_.int 0) arityO) output-func-args (_.array-slice/2 @curried arityO)] (_.return! (_.call-user-func-array/2 (_.call-user-func-array/2 @function arity-args) output-func-args))) (let [@missing (_.var "missing")] (_.return! (_.function (list) (list (_.reference @function) (_.reference @curried)) (|> (_.set! @missing _.func-get-args/0) (_.then! (_.return! (_.call-user-func-array/2 @function (_.array-merge/+ @curried (list @missing)))))))))))))))))))