lux.analyser.lux.clj Maven / Gradle / Ivy
Go to download
Show more of this group Show more artifacts with this name
Show all versions of luxc-jvm Show documentation
Show all versions of luxc-jvm Show documentation
The JVM compiler for the Lux programming language.
;; Copyright (c) Eduardo Julian. All rights reserved.
;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
;; If a copy of the MPL was not distributed with this file,
;; You can obtain one at http://mozilla.org/MPL/2.0/.
(ns lux.analyser.lux
(:require (clojure [template :refer [do-template]])
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [|do return return* fail fail* |let |list |case]]
[parser :as &parser]
[type :as &type]
[host :as &host])
(lux.analyser [base :as &&]
[lambda :as &&lambda]
[case :as &&case]
[env :as &&env]
[module :as &&module]
[record :as &&record]
[meta :as &&meta])))
;; [Utils]
;; TODO: Walk the type to set up the bound-type, instead of doing a
;; rough calculation like this one.
(defn ^:private count-univq [type]
"(-> Type Int)"
(|case type
(&/$UnivQ env type*)
(inc (count-univq type*))
_
0))
;; TODO: This technique won't work if the body of the type contains
;; nested quantifications that are cannot be directly counted.
(defn ^:private next-bound-type [type]
"(-> Type Type)"
(&/$BoundT (->> (count-univq type) (* 2) (+ 1))))
(defn ^:private embed-inferred-input [input output]
"(-> Type Type Type)"
(|case output
(&/$UnivQ env output*)
(&/$UnivQ env (embed-inferred-input input output*))
_
(&/$LambdaT input output)))
;; [Exports]
(defn analyse-unit [analyse ?exo-type]
(|do [_cursor &/cursor
_ (&type/check ?exo-type &/$UnitT)]
(return (&/|list (&&/|meta ?exo-type _cursor
(&&/$tuple (&/|list)))))))
(defn analyse-tuple [analyse ?exo-type ?elems]
(|case ?elems
(&/$Nil)
(analyse-unit analyse (|case ?exo-type
(&/$Left exo-type) exo-type
(&/$Right exo-type) exo-type))
(&/$Cons ?elem (&/$Nil))
(analyse (|case ?exo-type
(&/$Left exo-type) exo-type
(&/$Right exo-type) exo-type)
?elem)
_
(|case ?exo-type
(&/$Left exo-type)
(|do [exo-type* (&type/actual-type exo-type)]
(|case exo-type*
(&/$UnivQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
[[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left exo-type**) ?elems))
=var (&type/resolve-type $var)
inferred-type (|case =var
(&/$VarT iid)
(|do [:let [=var* (next-bound-type tuple-type)]
_ (&type/set-var iid =var*)
tuple-type* (&type/clean $var tuple-type)]
(return (&/$UnivQ &/$Nil tuple-type*)))
_
(&type/clean $var tuple-type))]
(return (&/|list (&&/|meta inferred-type tuple-cursor
tuple-analysis))))))
_
(analyse-tuple analyse (&/$Right exo-type*) ?elems)))
(&/$Right exo-type)
(|do [unknown? (&type/unknown? exo-type)]
(if unknown?
(|do [=elems (&/map% #(|do [=analysis (&&/analyse-1+ analyse %)]
(return =analysis))
?elems)
_ (&type/check exo-type (|case (->> (&/|map &&/expr-type* =elems) (&/|reverse))
(&/$Cons last prevs)
(&/fold (fn [right left] (&/$ProdT left right))
last prevs)))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$tuple =elems)
))))
(|do [exo-type* (&type/actual-type exo-type)]
(&/with-attempt
(|case exo-type*
(&/$ProdT _)
(|let [num-elems (&/|length ?elems)
[_shorter _tuple-types] (&type/tuple-types-for num-elems exo-type*)]
(if (= num-elems _shorter)
(|do [=elems (&/map2% (fn [elem-t elem]
(&&/analyse-1 analyse elem-t elem))
_tuple-types
?elems)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$tuple =elems)
))))
(|do [=direct-elems (&/map2% (fn [elem-t elem] (&&/analyse-1 analyse elem-t elem))
(&/|take (dec _shorter) _tuple-types)
(&/|take (dec _shorter) ?elems))
=indirect-elems (analyse-tuple analyse
(&/$Right (&/|last _tuple-types))
(&/|drop (dec _shorter) ?elems))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$tuple (&/|++ =direct-elems =indirect-elems))
))))))
(&/$ExQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
[[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems))
=tuple-analysis (&&/clean-analysis $var (&&/|meta exo-type tuple-cursor
tuple-analysis))]
(return (&/|list =tuple-analysis)))))
(&/$UnivQ _)
(|do [$var &type/existential
:let [(&/$ExT $var-id) $var]
exo-type** (&type/apply-type exo-type* $var)
[[tuple-type tuple-cursor] tuple-analysis] (&/with-scope-type-var $var-id
(&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems)))]
(return (&/|list (&&/|meta exo-type tuple-cursor
tuple-analysis))))
_
(&/fail-with-loc (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*)))
)
(fn [err]
(&/fail-with-loc (str err "\n" "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type)))))))))
))
(defn ^:private analyse-variant-body [analyse exo-type ?values]
(|do [_cursor &/cursor
output (|case ?values
(&/$Nil)
(analyse-unit analyse exo-type)
(&/$Cons ?value (&/$Nil))
(analyse exo-type ?value)
_
(analyse-tuple analyse (&/$Right exo-type) ?values))]
(|case output
(&/$Cons x (&/$Nil))
(return x)
_
(&/fail-with-loc "[Analyser Error] Can't expand to other than 1 element."))))
(defn analyse-variant [analyse ?exo-type idx is-last? ?values]
(|case ?exo-type
(&/$Left exo-type)
(|do [exo-type* (&type/actual-type exo-type)]
(|case exo-type*
(&/$UnivQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
[[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left exo-type**) idx is-last? ?values))
=var (&type/resolve-type $var)
inferred-type (|case =var
(&/$VarT iid)
(|do [:let [=var* (next-bound-type variant-type)]
_ (&type/set-var iid =var*)
variant-type* (&type/clean $var variant-type)]
(return (&/$UnivQ &/$Nil variant-type*)))
_
(&type/clean $var variant-type))]
(return (&/|list (&&/|meta inferred-type variant-cursor
variant-analysis))))))
_
(analyse-variant analyse (&/$Right exo-type*) idx is-last? ?values)))
(&/$Right exo-type)
(|do [exo-type* (|case exo-type
(&/$VarT ?id)
(&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
(&type/actual-type exo-type*))
(|do [_ (&type/set-var ?id &type/Type)]
(&type/actual-type &type/Type))))
_
(&type/actual-type exo-type))]
(&/with-attempt
(|case exo-type*
(&/$SumT _)
(|do [vtype (&type/sum-at idx exo-type*)
:let [num-variant-types (&/|length (&type/flatten-sum exo-type*))
is-last?* (if (nil? is-last?)
(= idx (dec num-variant-types))
is-last?)]
=value (analyse-variant-body analyse vtype ?values)
_cursor &/cursor]
(if (= 1 num-variant-types)
(return (&/|list =value))
(return (&/|list (&&/|meta exo-type _cursor (&&/$variant idx is-last?* =value))))
))
(&/$UnivQ _)
(|do [$var &type/existential
exo-type** (&type/apply-type exo-type* $var)]
(analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values))
(&/$ExQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
=exprs (analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values)]
(&/map% (partial &&/clean-analysis $var) =exprs))))
_
(&/fail-with-loc (str "[Analyser Error] Can't create variant if the expected type is " (&type/show-type exo-type*) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))
(fn [err]
(|case exo-type
(&/$VarT ?id)
(|do [=exo-type (&type/deref ?id)]
(&/fail-with-loc (str err "\n" "[Analyser Error] Can't create variant if the expected type is " (&type/show-type =exo-type) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))
_
(&/fail-with-loc (str err "\n" "[Analyser Error] Can't create variant if the expected type is " (&type/show-type exo-type) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
)))
(defn analyse-record [analyse exo-type ?elems]
(|do [[rec-members rec-type] (&&record/order-record ?elems)]
(|case exo-type
(&/$VarT id)
(|do [? (&type/bound? id)]
(if ?
(analyse-tuple analyse (&/$Right exo-type) rec-members)
(|do [[[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members))
_ (&type/check exo-type tuple-type)]
(return (&/|list (&&/|meta exo-type tuple-cursor
tuple-analysis))))))
_
(analyse-tuple analyse (&/$Right exo-type) rec-members)
)))
(defn ^:private analyse-global [analyse exo-type module name]
(|do [[[r-module r-name] [endo-type ?meta ?value]] (&&module/find-def module name)
_ (if (and (clojure.lang.Util/identical &type/Type endo-type)
(clojure.lang.Util/identical &type/Type exo-type))
(return nil)
(&type/check exo-type endo-type))
_cursor &/cursor]
(return (&/|list (&&/|meta endo-type _cursor
(&&/$var (&/$Global (&/T [r-module r-name])))
)))))
(defn ^:private analyse-local [analyse exo-type name]
(fn [state]
(|let [stack (&/get$ &/$envs state)
no-binding? #(and (->> % (&/get$ &/$locals) (&/get$ &/$mappings) (&/|contains? name) not)
(->> % (&/get$ &/$closure) (&/get$ &/$mappings) (&/|contains? name) not))
[inner outer] (&/|split-with no-binding? stack)]
(|case outer
(&/$Nil)
(&/run-state (|do [module-name &/get-module-name]
(analyse-global analyse exo-type module-name name))
state)
(&/$Cons ?genv (&/$Nil))
(if-let [global (->> ?genv (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))]
(|case global
[(&/$Global ?module* name*) _]
(&/run-state (analyse-global analyse exo-type ?module* name*)
state)
_
(fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))
(fail* (str "[Analyser Error] Unknown global definition: " name)))
(&/$Cons bottom-outer _)
(|let [scopes (&/|map #(&/get$ &/$name %) (&/|reverse inner))
[=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
(|let [[register new-inner] register+new-inner
[register* frame*] (&&lambda/close-over in-scope name register frame)]
(&/T [register* (&/$Cons frame* new-inner)])))
(&/T [(or (->> bottom-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))
(->> bottom-outer (&/get$ &/$closure) (&/get$ &/$mappings) (&/|get name)))
&/$Nil])
(&/|reverse inner) scopes)]
((|do [_ (&type/check exo-type (&&/expr-type* =local))]
(return (&/|list =local)))
(&/set$ &/$envs (&/|++ inner* outer) state)))
))))
(defn analyse-symbol [analyse exo-type ident]
(|do [:let [[?module ?name] ident]]
(if (= "" ?module)
(analyse-local analyse exo-type ?name)
(analyse-global analyse exo-type ?module ?name))
))
(defn ^:private analyse-apply* [analyse exo-type fun-type ?args]
(|case ?args
(&/$Nil)
(|do [_ (&type/check exo-type fun-type)]
(return (&/T [fun-type &/$Nil])))
(&/$Cons ?arg ?args*)
(|do [?fun-type* (&type/actual-type fun-type)]
(&/with-attempt
(|case ?fun-type*
(&/$UnivQ _)
(&type/with-var
(fn [$var]
(|do [type* (&type/apply-type ?fun-type* $var)
[=output-t =args] (analyse-apply* analyse exo-type type* ?args)
==args (&/map% (partial &&/clean-analysis $var) =args)]
(|case $var
(&/$VarT ?id)
(|do [? (&type/bound? ?id)
type** (if ?
(&type/clean $var =output-t)
(|do [_ (&type/set-var ?id (next-bound-type =output-t))
cleaned-output* (&type/clean $var =output-t)
:let [cleaned-output (&/$UnivQ &/$Nil cleaned-output*)]]
(return cleaned-output)))
_ (&type/clean $var exo-type)]
(return (&/T [type** ==args])))
))))
(&/$ExQ _)
(|do [$var &type/existential
type* (&type/apply-type ?fun-type* $var)]
(analyse-apply* analyse exo-type type* ?args))
(&/$LambdaT ?input-t ?output-t)
(|do [[=output-t =args] (analyse-apply* analyse exo-type ?output-t ?args*)
=arg (&/with-attempt
(&&/analyse-1 analyse ?input-t ?arg)
(fn [err]
(&/fail-with-loc (str err "\n" "[Analyser Error] Function expected: " (&type/show-type ?input-t)))))]
(return (&/T [=output-t (&/$Cons =arg =args)])))
_
(&/fail-with-loc (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))
(fn [err]
(&/fail-with-loc (str err "\n" "[Analyser Error] Can't apply function " (&type/show-type fun-type) " to args: " (->> ?args (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
))
(defn ^:private do-analyse-apply [analyse exo-type =fn ?args]
(|do [:let [[[=fn-type =fn-cursor] =fn-form] =fn]
[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
(return (&/|list (&&/|meta =output-t =fn-cursor
(&&/$apply =fn =args)
)))))
(defn analyse-apply [analyse cursor exo-type =fn ?args]
(|do [loader &/loader
:let [[[=fn-type =fn-cursor] =fn-form] =fn]]
(|case =fn-form
(&&/$var (&/$Global ?module ?name))
(|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)]
(|case (&&meta/meta-get &&meta/macro?-tag ?meta)
(&/$Some _)
(|do [macro-expansion (fn [state]
(|case (-> ?value (.apply ?args) (.apply state))
(&/$Right state* output)
(&/$Right (&/T [state* output]))
(&/$Left error)
((&/fail-with-loc error) state)))
module-name &/get-module-name
;; :let [[r-prefix r-name] real-name
;; _ (when (or (= "actor:" r-name)
;; ;; (= "|Codec@Json|" r-name)
;; ;; (= "|Codec@Json//encode|" r-name)
;; ;; (= "|Codec@Json//decode|" r-name)
;; ;; (= "derived:" r-name)
;; )
;; (->> (&/|map &/show-ast macro-expansion)
;; (&/|interpose "\n")
;; (&/fold str "")
;; (prn (&/ident->text real-name) module-name)))
;; ]
]
(&/flat-map% (partial analyse exo-type) macro-expansion))
_
(&/with-analysis-meta cursor exo-type
(do-analyse-apply analyse exo-type =fn ?args))))
_
(&/with-analysis-meta cursor exo-type
(do-analyse-apply analyse exo-type =fn ?args)))
))
(defn analyse-case [analyse exo-type ?value ?branches]
(|do [:let [num-branches (&/|length ?branches)]
_ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case\" expression.")
_ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case\" expression.")
=value (&&/analyse-1+ analyse ?value)
:let [var?? (|case =value
[_ (&&/$var =var-kind)]
(&/$Some =value)
_
&/$None)]
=match (&&case/analyse-branches analyse exo-type var?? (&&/expr-type* =value) (&/|as-pairs ?branches))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$case =value =match)
)))))
(defn ^:private unravel-inf-appt [type]
(|case type
(&/$AppT =input+ (&/$VarT _inf-var))
(&/$Cons _inf-var (unravel-inf-appt =input+))
_
(&/|list)))
(defn ^:private clean-func-inference [$input $output =input =func]
(|case =input
(&/$VarT iid)
(|do [:let [=input* (next-bound-type =func)]
_ (&type/set-var iid =input*)
=func* (&type/clean $input =func)
=func** (&type/clean $output =func*)]
(return (&/$UnivQ &/$Nil =func**)))
(&/$AppT =input+ (&/$VarT _inf-var))
(&/fold% (fn [_func _inf-var]
(|do [:let [$inf-var (&/$VarT _inf-var)]
=inf-var (&type/resolve-type $inf-var)
_func* (clean-func-inference $inf-var $output =inf-var _func)
_ (&type/delete-var _inf-var)]
(return _func*)))
=func
(unravel-inf-appt =input))
(&/$ProdT _ _)
(&/fold% (fn [_func _inf-var]
(|do [:let [$inf-var (&/$VarT _inf-var)]
=inf-var (&type/resolve-type $inf-var)
_func* (clean-func-inference $inf-var $output =inf-var _func)
_ (&type/delete-var _inf-var)]
(return _func*)))
=func
(&/|reverse (&type/flatten-prod =input)))
_
(|do [=func* (&type/clean $input =func)
=func** (&type/clean $output =func*)]
(return =func**))))
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
(|case exo-type
(&/$VarT id)
(|do [? (&type/bound? id)]
(if ?
(|do [exo-type* (&type/deref id)]
(analyse-lambda* analyse exo-type* ?self ?arg ?body))
;; Inference
(&type/with-var
(fn [$input]
(&type/with-var
(fn [$output]
(|do [[[lambda-type lambda-cursor] lambda-analysis] (analyse-lambda* analyse (&/$LambdaT $input $output) ?self ?arg ?body)
=input (&type/resolve-type $input)
=output (&type/resolve-type $output)
inferred-type (clean-func-inference $input $output =input (embed-inferred-input =input =output))
_ (&type/check exo-type inferred-type)]
(return (&&/|meta inferred-type lambda-cursor
lambda-analysis)))
))))))
_
(&/with-attempt
(|do [exo-type* (&type/actual-type exo-type)]
(|case exo-type*
(&/$UnivQ _)
(|do [$var &type/existential
:let [(&/$ExT $var-id) $var]
exo-type** (&type/apply-type exo-type* $var)]
(&/with-scope-type-var $var-id
(analyse-lambda* analyse exo-type** ?self ?arg ?body)))
(&/$ExQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
=expr (analyse-lambda* analyse exo-type** ?self ?arg ?body)]
(&&/clean-analysis $var =expr))))
(&/$LambdaT ?arg-t ?return-t)
(|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type*
?arg ?arg-t
(&&/analyse-1 analyse ?return-t ?body))
_cursor &/cursor]
(return (&&/|meta exo-type* _cursor
(&&/$lambda =scope =captured =body))))
_
(fail "")))
(fn [err]
(&/fail-with-loc (str err "\n" "[Analyser Error] Functions require function types: " (&type/show-type exo-type)))))
))
(defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
(|case exo-type
(&/$UnivQ _)
(|do [$var &type/existential
:let [(&/$ExT $var-id) $var]
exo-type* (&type/apply-type exo-type $var)
[_ _expr] (&/with-scope-type-var $var-id
(analyse-lambda** analyse exo-type* ?self ?arg ?body))
_cursor &/cursor]
(return (&&/|meta exo-type _cursor _expr)))
(&/$VarT id)
(|do [? (&type/bound? id)]
(if ?
(|do [exo-type* (&type/actual-type exo-type)]
(analyse-lambda* analyse exo-type* ?self ?arg ?body))
;; Inference
(analyse-lambda* analyse exo-type ?self ?arg ?body)))
_
(|do [exo-type* (&type/actual-type exo-type)]
(analyse-lambda* analyse exo-type* ?self ?arg ?body))
))
(defn analyse-lambda [analyse exo-type ?self ?arg ?body]
(|do [output (&/with-no-catches
(analyse-lambda** analyse exo-type ?self ?arg ?body))]
(return (&/|list output))))
(defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta]
(|do [_ &/ensure-statement
module-name &/get-module-name
? (&&module/defined? module-name ?name)]
(if ?
(&/fail-with-loc (str "[Analyser Error] Can't redefine " (str module-name ";" ?name)))
(|do [=value (&/without-repl-closure
(&/with-scope ?name
(&&/analyse-1+ analyse ?value)))
=meta (&&/analyse-1 analyse &type/DefMeta ?meta)
==meta (eval! (optimize =meta))
_ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value))
_ (&&module/test-macro module-name ?name ==meta (&&/expr-type* =value))
_ (compile-def ?name (optimize =value) ==meta)]
(return &/$Nil))
)))
(defn analyse-import [analyse compile-module path ex-alias]
(|do [_ &/ensure-statement
current-module &/get-module-name
_ (if (= current-module path)
(&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path))
(return nil))]
(&/without-repl
(&/save-module
(|do [already-compiled? (&&module/exists? path)
active? (&/active-module? path)
_ (&/assert! (not active?)
(str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module))
_ (&&module/add-import path)
?module-hash (if (not already-compiled?)
(compile-module path)
(&&module/module-hash path))
_ (if (= "" ex-alias)
(return nil)
(&&module/alias current-module ex-alias path))]
(return &/$Nil))))))
(defn ^:private coerce [new-type analysis]
"(-> Type Analysis Analysis)"
(|let [[[_type _cursor] _analysis] analysis]
(&&/|meta new-type _cursor
_analysis)))
(defn analyse-ann [analyse eval! exo-type ?type ?value]
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
==type (eval! =type)
_ (&type/check exo-type ==type)
=value (&/with-expected-type ==type
(&&/analyse-1 analyse ==type ?value))
_cursor &/cursor
;; =value (&&/analyse-1 analyse ==type ?value)
;; :let [_ (prn 0 (&/adt->text =value))
;; _ (prn 1 (&/adt->text (coerce ==type =value)))
;; _ (prn 2 (&/adt->text (&&/|meta ==type _cursor
;; (&&/$ann =value =type ==type)
;; )))]
]
;; (return (&/|list (coerce ==type =value)))
;; (analyse ==type ?value)
(return (&/|list (&&/|meta ==type _cursor
(&&/$ann =value =type ==type)
)))
))
(defn analyse-coerce [analyse eval! exo-type ?type ?value]
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
==type (eval! =type)
_ (&type/check exo-type ==type)
=value (&&/analyse-1+ analyse ?value)]
(return (&/|list (coerce ==type =value)))))
(let [input-type (&/$AppT &type/List &type/Text)
output-type (&/$AppT &type/IO &/$UnitT)]
(defn analyse-program [analyse optimize compile-program ?args ?body]
(|do [_ &/ensure-statement
=body (&/with-scope ""
(&&env/with-local ?args input-type
(&&/analyse-1 analyse output-type ?body)))
_ (compile-program (optimize =body))]
(return &/$Nil))))