(;module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data ["e" error]
[product]
text/format)
[macro]
(lang [type]
(type ["tc" check]))
[host])
(luxc ["&" lang]
(lang ["&;" module]
[";L" host]
[";L" macro]
["la" analysis]
(translation [";T" common])))
(.. [";A" common]
[";A" function]
[";A" primitive]
[";A" reference]
[";A" structure]
[";A" procedure]))
(exception: #export Macro-Expression-Must-Have-Single-Expansion)
(exception: #export Unrecognized-Syntax)
(exception: #export Macro-Expansion-Failed)
(def: #export (analyser eval)
(-> &;Eval &;Analyser)
(: (-> Code (Meta la;Analysis))
(function analyse [code]
(do macro;Monad
[expectedT macro;expected-type]
(let [[cursor code'] code]
## The cursor must be set in the compiler for the sake
## of having useful error messages.
(&;with-cursor cursor
(case code'
(^template [ ]
( value)
( value))
([#;Bool primitiveA;analyse-bool]
[#;Nat primitiveA;analyse-nat]
[#;Int primitiveA;analyse-int]
[#;Deg primitiveA;analyse-deg]
[#;Frac primitiveA;analyse-frac]
[#;Text primitiveA;analyse-text])
(^ (#;Tuple (list)))
primitiveA;analyse-unit
## Singleton tuples are equivalent to the element they contain.
(^ (#;Tuple (list singleton)))
(analyse singleton)
(^ (#;Tuple elems))
(structureA;analyse-product analyse elems)
(^ (#;Record pairs))
(structureA;analyse-record analyse pairs)
(#;Symbol reference)
(referenceA;analyse-reference reference)
(^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
(procedureA;analyse-procedure analyse eval proc-name proc-args)
(^template [ ]
(^ (#;Form (list& [_ ( tag)]
values)))
(case values
(#;Cons value #;Nil)
( analyse tag value)
_
( analyse tag (` [(~@ values)]))))
([#;Nat structureA;analyse-sum]
[#;Tag structureA;analyse-tagged-sum])
(#;Tag tag)
(structureA;analyse-tagged-sum analyse tag (' []))
(^ (#;Form (list& func args)))
(do macro;Monad
[[funcT funcA] (commonA;with-unknown-type
(analyse func))]
(case funcA
[_ (#;Symbol def-name)]
(do @
[?macro (&;with-error-tracking
(macro;find-macro def-name))]
(case ?macro
(#;Some macro)
(do @
[expansion (function [compiler]
(case (macroL;expand macro args compiler)
(#e;Success [compiler' output])
(#e;Success [compiler' output])
(#e;Error error)
((&;throw Macro-Expansion-Failed error) compiler)))]
(case expansion
(^ (list single))
(analyse single)
_
(&;throw Macro-Expression-Must-Have-Single-Expansion (%code code))))
_
(functionA;analyse-apply analyse funcT funcA args)))
_
(functionA;analyse-apply analyse funcT funcA args)))
_
(&;throw Unrecognized-Syntax (%code code))
)))))))