(;module: lux (lux (control monad ["ex" exception #+ exception:] ["p" parser]) (data ["e" error] text/format) [meta] (meta ["s" syntax])) (luxc ["&" base] (host ["$" jvm]) (lang ["ls" synthesis] (translation [";T" common] [";T" primitive] [";T" structure] [";T" eval] [";T" procedure] [";T" function] [";T" reference] [";T" case]) [";L" variable #+ Variable Register]))) (exception: #export Unrecognized-Synthesis) (def: #export (generate synthesis) (-> ls;Synthesis (Meta $;Inst)) (case synthesis (^code []) primitiveT;generate-unit (^code [(~ singleton)]) (generate singleton) (^template [ ] [_ ( value)] ( value)) ([#;Bool primitiveT;generate-bool] [#;Nat primitiveT;generate-nat] [#;Int primitiveT;generate-int] [#;Deg primitiveT;generate-deg] [#;Frac primitiveT;generate-frac] [#;Text primitiveT;generate-text]) (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Bool last?)]) (~ valueS))) (structureT;generate-variant generate tag last? valueS) (^code [(~@ members)]) (structureT;generate-tuple generate members) (^ [_ (#;Form (list [_ (#;Int var)]))]) (if (variableL;captured? var) (referenceT;generate-captured var) (referenceT;generate-variable var)) [_ (#;Symbol definition)] (referenceT;generate-definition definition) (^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ exprS))) (caseT;generate-let generate register inputS exprS) (^code ("lux case" (~ inputS) (~ pathPS))) (caseT;generate-case generate inputS pathPS) (^multi (^code ("lux function" (~ [_ (#;Nat arity)]) [(~@ environment)] (~ bodyS))) [(s;run environment (p;some s;int)) (#e;Success environment)]) (functionT;generate-function generate environment arity bodyS) (^code ("lux call" (~ functionS) (~@ argsS))) (functionT;generate-call generate functionS argsS) (^code ((~ [_ (#;Text procedure)]) (~@ argsS))) (procedureT;generate-procedure generate procedure argsS) _ (&;throw Unrecognized-Synthesis (%code synthesis)) ))