blob: 27d017a8a0dd9041ac2fdc8d71e18a2e981b3fb4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
(.module:
[library
[lux {"-" [function]}
[abstract
["." monad {"+" [do]}]]
[control
pipe]
[data
["." product]
[text
["%" format {"+" [format]}]]
[collection
["." list ("#\." functor)]]]
[target
["_" common_lisp {"+" [Expression Var/1]}]]]]
["." // "_"
["#." runtime {"+" [Operation Phase Generator]}]
["#." reference]
["#." case]
["/#" // "_"
["#." reference]
["//#" /// "_"
[analysis {"+" [Variant Tuple Abstraction Application Analysis]}]
[synthesis {"+" [Synthesis]}]
["#." generation {"+" [Context]}]
["//#" /// "_"
[arity {"+" [Arity]}]
["#." phase ("#\." monad)]
[reference
[variable {"+" [Register Variable]}]]]]]])
(def: .public (apply expression archive [functionS argsS+])
(Generator (Application Synthesis))
(do [! ///////phase.monad]
[functionG (expression archive functionS)
argsG+ (monad.each ! (expression archive) argsS+)]
(in (_.funcall/+ [functionG argsG+]))))
(def: capture
(-> Register Var/1)
(|>> (///reference.foreign //reference.system) :expected))
(def: (with_closure inits function_definition)
(-> (List (Expression Any)) (Expression Any) (Operation (Expression Any)))
(case inits
#.End
(\ ///////phase.monad in function_definition)
_
(do [! ///////phase.monad]
[@closure (\ ! each _.var (/////generation.identifier "closure"))]
(in (_.labels (list [@closure [(|> (list.enumeration inits)
(list\each (|>> product.left ..capture))
_.args)
function_definition]])
(_.funcall/+ [(_.function/1 @closure) inits]))))))
(def: input
(|>> ++ //case.register))
(def: .public (function expression archive [environment arity bodyS])
(Generator (Abstraction Synthesis))
(do [! ///////phase.monad]
[@scope (\ ! each (|>> %.nat (format "function_scope") _.tag) /////generation.next)
@output (\ ! each (|>> %.nat (format "loop_output") _.var) /////generation.next)
[function_name bodyG] (/////generation.with_new_context archive
(/////generation.with_anchor [@scope 1]
(expression archive bodyS)))
closureG+ (monad.each ! (expression archive) environment)
.let [@curried (_.var "curried")
@missing (_.var "missing")
arityG (|> arity .int _.int)
@num_args (_.var "num_args")
@self (_.var (///reference.artifact function_name))
initialize_self! [(//case.register 0) (_.function/1 @self)]
initialize! [(|> (list.indices arity)
(list\each ..input)
_.args)
@curried]]]
(with_closure closureG+
(_.labels (list [@self [(_.args& (list) @curried)
(_.let (list [@num_args (_.length/1 @curried)])
(list (_.cond (list [(_.=/2 [arityG @num_args])
(_.let (list [@output _.nil]
initialize_self!)
(list (_.destructuring-bind initialize!
(list (_.tagbody
(list @scope
(_.setq @output bodyG)))
@output))))]
[(_.>/2 [arityG @num_args])
(let [arity_inputs (_.subseq/3 [@curried (_.int +0) arityG])
extra_inputs (_.subseq/3 [@curried arityG @num_args])]
(_.apply/2 [(_.apply/2 [(_.function/1 @self)
arity_inputs])
extra_inputs]))])
... (|> @num_args (_.< arityG))
(_.lambda (_.args& (list) @missing)
(_.apply/2 [(_.function/1 @self)
(_.append/2 [@curried @missing])])))))]])
(_.function/1 @self)))
))
|
