(.module: lux (lux (control monad ["ex" exception #+ exception:]) (data ["e" error] [maybe] [text "text/" Monoid Hash] text/format (coll [list "list/" Functor Fold])) [macro]) (luxc ["&" lang] ["&." io] (lang (host ["$" jvm] (jvm ["$t" type] ["$d" def] ["$i" inst])) ["&." scope] ["&." module] [".L" host])) (// [".T" common] [".T" runtime])) ## (def: (lux//program procedure) ## (-> Text //.Statement) ## (function (_ inputsC+) ## (case inputsC+ ## (^ (list [_ (#.Identifier ["" args])] programC)) ## (do macro.Monad ## [[_ programA] (<| lang.with-scope ## (scopeL.with-local [args (type (List Text))]) ## (lang.with-type (type (IO Any))) ## (expressionA.analyser evalL.eval programC)) ## syntheses //.all-syntheses ## programI (expressionT.translate (expressionS.synthesize syntheses programA)) ## _ (statementT.translate-program programI)] ## (wrap [])) ## _ ## (throw-invalid-statement procedure inputsC+)))) (def: #export (translate-program programI) (-> $.Inst (Meta Any)) (let [nilI runtimeT.noneI num-inputsI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH) decI (|>> ($i.int 1) $i.ISUB) headI (|>> $i.DUP ($i.ALOAD +0) $i.SWAP $i.AALOAD $i.SWAP $i.DUP_X2 $i.POP) pairI (|>> ($i.int 2) ($i.ANEWARRAY "java.lang.Object") $i.DUP_X1 $i.SWAP ($i.int 0) $i.SWAP $i.AASTORE $i.DUP_X1 $i.SWAP ($i.int 1) $i.SWAP $i.AASTORE) consI (|>> ($i.int 1) ($i.string "") $i.DUP2_X1 $i.POP2 runtimeT.variantI) prepare-input-listI (<| $i.with-label (function (_ @loop)) $i.with-label (function (_ @end)) (|>> nilI num-inputsI ($i.label @loop) decI $i.DUP ($i.IFLT @end) headI pairI consI $i.SWAP ($i.GOTO @loop) ($i.label @end) $i.POP ($i.ASTORE +0))) run-ioI (|>> ($i.CHECKCAST hostL.function-class) $i.NULL ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature +1) #0)) main-type ($t.method (list ($t.array +1 ($t.class "java.lang.String" (list)))) #.None (list))] (do macro.Monad [current-module macro.current-module-name #let [normal-name "_" bytecode-name (format current-module "/" normal-name) class-name (text.replace-all "/" "." bytecode-name) bytecode ($d.class #$.V1_6 #$.Public $.finalC bytecode-name (list) ["java.lang.Object" (list)] (list) (|>> ($d.method #$.Public $.staticM "main" main-type (|>> prepare-input-listI programI run-ioI $i.POP $i.RETURN))))] #let [_ (log! (format "PROGRAM " current-module))] _ (commonT.store-class class-name bytecode)] (commonT.record-artifact (format bytecode-name ".class") bytecode))))