(.module: lux (lux (control [monad #+ do] pipe) (data [product] [text] text/format (coll [list "list/" Functor Fold])) [macro]) (luxc ["&" lang] (lang ["ls" synthesis] [".L" variable #+ Variable] (host ["_" common-lisp #+ Expression @@]))) [//] (// [".T" reference] [".T" runtime])) (def: #export (translate-apply translate functionS argsS+) (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression)) (do macro.Monad [functionO (translate functionS) argsO+ (monad.map @ translate argsS+)] (wrap (_.funcall argsO+ functionO)))) (def: $curried (_.var "curried")) (def: $missing (_.var "missing")) (def: input-declaration (|>> n/inc referenceT.variable)) (def: (with-closure function-name inits function-definition) (-> Text (List Expression) Expression (Meta Expression)) (let [$closure (_.var (format function-name "___CLOSURE"))] (do macro.Monad [] (case inits #.Nil (wrap function-definition) _ (wrap (_.labels (list [$closure [(|> (list.enumerate inits) (list/map (|>> product.left referenceT.closure)) _.poly) function-definition]]) (_.funcall inits (_.function (@@ $closure))))))))) (def: #export (translate-function translate env arity bodyS) (-> (-> ls.Synthesis (Meta Expression)) (List Variable) ls.Arity ls.Synthesis (Meta Expression)) (do macro.Monad [[function-name bodyO] (//.with-sub-context (do @ [function-name //.context] (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) #let [arityO (|> arity nat-to-int _.int) $num_args (_.var "num_args") $function (_.var function-name)]] (with-closure function-name closureO+ (_.labels (list [$function [(_.poly+ (list) $curried) (_.let (list [$num_args (_.length (@@ $curried))]) (<| (_.if (|> (@@ $num_args) (_.= arityO)) (_.let (list [(referenceT.variable +0) (_.function (@@ $function))]) (_.destructuring-bind [(|> (list.n/range +0 (n/dec arity)) (list/map input-declaration) _.poly) (@@ $curried)] bodyO))) (_.if (|> (@@ $num_args) (_.> arityO)) (let [arity-args (_.subseq/3 (@@ $curried) (_.int 0) arityO) output-func-args (_.subseq/3 (@@ $curried) arityO (@@ $num_args))] (|> (_.function (@@ $function)) (_.apply arity-args) (_.apply output-func-args)))) ## (|> (@@ $num_args) (_.< arityO)) (_.lambda (_.poly+ (list) $missing) (|> (_.function (@@ $function)) (_.apply (_.append (@@ $curried) (@@ $missing)))))))]]) (_.function (@@ $function)))) ))