From f4bb7ff1455659a766a074506b54129e0037db64 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 Mar 2019 12:09:56 -0400 Subject: Some refactoring around synthesis. --- .../source/luxc/lang/translation/jvm/case.jvm.lux | 4 +- .../luxc/lang/translation/jvm/common.jvm.lux | 2 +- .../luxc/lang/translation/jvm/expression.jvm.lux | 2 +- .../luxc/lang/translation/jvm/function.jvm.lux | 2 +- .../source/luxc/lang/translation/jvm/loop.jvm.lux | 2 +- .../lang/translation/jvm/procedure/common.jvm.lux | 2 +- .../luxc/lang/translation/jvm/structure.jvm.lux | 4 +- .../lux/tool/compiler/default/evaluation.lux | 12 +- stdlib/source/lux/tool/compiler/default/init.lux | 6 +- .../tool/compiler/phase/extension/statement.lux | 4 +- .../tool/compiler/phase/extension/synthesis.lux | 2 +- .../source/lux/tool/compiler/phase/statement.lux | 4 +- .../source/lux/tool/compiler/phase/synthesis.lux | 542 ++++----------------- .../lux/tool/compiler/phase/synthesis/case.lux | 91 ++-- .../tool/compiler/phase/synthesis/expression.lux | 89 ---- .../lux/tool/compiler/phase/synthesis/function.lux | 101 ++-- .../lux/tool/compiler/phase/synthesis/loop.lux | 157 +++--- .../source/lux/tool/compiler/phase/translation.lux | 35 +- .../phase/translation/common/reference.lux | 2 +- .../tool/compiler/phase/translation/js/case.lux | 4 +- .../compiler/phase/translation/js/expression.lux | 5 +- .../phase/translation/js/extension/common.lux | 5 +- .../phase/translation/js/extension/host.lux | 5 +- .../compiler/phase/translation/js/function.lux | 2 +- .../tool/compiler/phase/translation/js/loop.lux | 3 +- .../tool/compiler/phase/translation/js/runtime.lux | 4 +- .../compiler/phase/translation/js/structure.lux | 4 +- stdlib/source/lux/tool/compiler/synthesis.lux | 468 ++++++++++++++++++ 28 files changed, 787 insertions(+), 776 deletions(-) delete mode 100644 stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux create mode 100644 stdlib/source/lux/tool/compiler/synthesis.lux diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux index 72c316d83..457c052a2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -9,8 +9,8 @@ format]] [tool [compiler - ["." phase ("operation/." monad) - ["." synthesis (#+ Path Synthesis)]]]]] + ["." synthesis (#+ Path Synthesis)] + ["." phase ("operation/." monad)]]]] [luxc [lang [host diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux index 57fc576fa..896fc9de3 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -16,8 +16,8 @@ [binary (#+ Binary)]] [tool [compiler - ["." name] [reference (#+ Register)] + ["." name] ["." phase]]]] ## [luxc ## [lang diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux index ba96731a8..c6b77e549 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux @@ -2,8 +2,8 @@ [lux #* [tool [compiler + ["." synthesis] [phase - ["." synthesis] ["." extension]]]]] [luxc [lang diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux index 87a930b7a..8c35952fd 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -12,9 +12,9 @@ [tool [compiler [analysis (#+ Arity)] + [synthesis (#+ Synthesis Abstraction Apply)] ["_." reference (#+ Register Variable)] ["." phase - [synthesis (#+ Synthesis Abstraction Apply)] ["." translation]]]]] [luxc [lang diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux index 5e01a4ea0..6e3f01c78 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux @@ -11,8 +11,8 @@ [tool [compiler [reference (#+ Register)] + ["." synthesis (#+ Synthesis)] ["." phase - ["." synthesis (#+ Synthesis)] ["." translation]]]]] [luxc [lang diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index afd140997..f63c82108 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -15,8 +15,8 @@ ["s" syntax (#+ syntax:)]] [tool [compiler + [synthesis (#+ Synthesis)] ["." phase - [synthesis (#+ Synthesis)] ["." extension ["." bundle]]]]] [host (#+ import:)]] diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux index a8d135f7a..7bf54b7ea 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -10,8 +10,8 @@ ["." list]]] [tool [compiler - ["." phase - [synthesis (#+ Synthesis)]]]]] + [synthesis (#+ Synthesis)] + ["." phase]]]] [luxc [lang [host diff --git a/stdlib/source/lux/tool/compiler/default/evaluation.lux b/stdlib/source/lux/tool/compiler/default/evaluation.lux index 3310a1fd1..42bb10ca0 100644 --- a/stdlib/source/lux/tool/compiler/default/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/default/evaluation.lux @@ -9,13 +9,13 @@ [/// ["." phase [macro (#+ Expander)] - ["." analysis + [".P" analysis ["." type]] - ["." synthesis - [".S" expression]] + [".P" synthesis] ["." translation] [// - [analysis (#+ Operation)]]]]) + [analysis (#+ Operation)] + ["." synthesis]]]]) (type: #export Eval (-> Nat Type Code (Operation Any))) @@ -27,13 +27,13 @@ (translation.State+ anchor expression statement) (translation.Phase anchor expression statement) Eval)) - (let [analyze (analysis.phase expander)] + (let [analyze (analysisP.phase expander)] (function (eval count type exprC) (do phase.monad [exprA (type.with-type type (analyze exprC))] (phase.lift (do error.monad - [exprS (|> exprA expressionS.phase (phase.run synthesis-state))] + [exprS (|> exprA synthesisP.phase (phase.run synthesis-state))] (phase.run translation-state (do phase.monad [exprO (translate exprS)] diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 41ecc851a..0958c3b01 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -18,13 +18,13 @@ ["." evaluation] ["/." // (#+ Instancer) ["." analysis] + ["." synthesis] ["." host] ["." phase [macro (#+ Expander)] [".P" analysis ["." module]] - ["." synthesis - [".S" expression]] + [".P" synthesis] ["." translation] ["." statement [".S" total]] @@ -84,7 +84,7 @@ {#statement.analysis {#statement.state analysis-state #statement.phase (analysisP.phase expander)} #statement.synthesis {#statement.state synthesis-state - #statement.phase expressionS.phase} + #statement.phase synthesisP.phase} #statement.translation {#statement.state translation-state #statement.phase translate}}])) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index ee70ddfc5..37ff93b9c 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -18,11 +18,11 @@ [analysis ["." module] ["." type]] - ["." synthesis (#+ Synthesis)] ["." translation] ["." statement (#+ Operation Handler Bundle)] [// - ["." analysis]]]]) + ["." analysis] + ["." synthesis (#+ Synthesis)]]]]) ## TODO: Inline "evaluate!'" into "evaluate!" ASAP (def: (evaluate!' translate code//type codeS) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux index 1a2e44f6f..40fb4f89e 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux @@ -2,7 +2,7 @@ [lux #*] [// ["." bundle] - [// + [/// [synthesis (#+ Bundle)]]]) (def: #export bundle diff --git a/stdlib/source/lux/tool/compiler/phase/statement.lux b/stdlib/source/lux/tool/compiler/phase/statement.lux index f2d508843..ba84d146f 100644 --- a/stdlib/source/lux/tool/compiler/phase/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/statement.lux @@ -1,11 +1,11 @@ (.module: [lux #*] ["." // - ["." synthesis] ["." translation] ["." extension] [// - ["." analysis]]]) + ["." analysis] + ["." synthesis]]]) (type: #export (Component state phase) {#state state diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/synthesis.lux index a484067bf..17af9a6fa 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis.lux @@ -1,468 +1,90 @@ (.module: - [lux (#- i64 Scope) + [lux (#- primitive) [control - [monad (#+ do)] - [equivalence (#+ Equivalence)] - ["ex" exception (#+ exception:)]] + ["." monad (#+ do)] + [pipe (#+ case>)]] [data - ["." bit ("#/." equivalence)] - ["." text ("#/." equivalence) - format] + ["." maybe] + ["." error] [collection ["." list ("#/." functor)] ["." dictionary (#+ Dictionary)]]]] - ["." // - ["." extension (#+ Extension)] - [// - ["." reference (#+ Register Variable Reference)] - ["." analysis (#+ Environment Arity Composite Analysis)]]]) - -(type: #export Resolver (Dictionary Variable Variable)) - -(type: #export State - {#locals Nat}) - -(def: #export fresh-resolver - Resolver - (dictionary.new reference.hash)) - -(def: #export init - State - {#locals 0}) - -(type: #export Primitive - (#Bit Bit) - (#I64 (I64 Any)) - (#F64 Frac) - (#Text Text)) - -(type: #export Side - (Either Nat Nat)) - -(type: #export Member - (Either Nat Nat)) - -(type: #export Access - (#Side Side) - (#Member Member)) - -(type: #export (Path' s) - #Pop - (#Test Primitive) - (#Access Access) - (#Bind Register) - (#Alt (Path' s) (Path' s)) - (#Seq (Path' s) (Path' s)) - (#Then s)) - -(type: #export (Abstraction' s) - {#environment Environment - #arity Arity - #body s}) - -(type: #export (Apply' s) - {#function s - #arguments (List s)}) - -(type: #export (Branch s) - (#Let s Register s) - (#If s s s) - (#Case s (Path' s))) - -(type: #export (Scope s) - {#start Register - #inits (List s) - #iteration s}) - -(type: #export (Loop s) - (#Scope (Scope s)) - (#Recur (List s))) - -(type: #export (Function s) - (#Abstraction (Abstraction' s)) - (#Apply s (List s))) - -(type: #export (Control s) - (#Branch (Branch s)) - (#Loop (Loop s)) - (#Function (Function s))) - -(type: #export #rec Synthesis - (#Primitive Primitive) - (#Structure (Composite Synthesis)) - (#Reference Reference) - (#Control (Control Synthesis)) - (#Extension (Extension Synthesis))) - -(do-template [ ] - [(type: #export - ( ..State Analysis Synthesis))] - - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] - [Handler extension.Handler] - [Bundle extension.Bundle] - ) - -(type: #export Path - (Path' Synthesis)) - -(def: #export path/pop - Path - #Pop) - -(do-template [ ] - [(template: #export ( content) - (#..Test ( content)))] - - [path/bit #..Bit] - [path/i64 #..I64] - [path/f64 #..F64] - [path/text #..Text] - ) - -(do-template [ ] - [(template: #export ( content) - (.<| #..Access - - content))] - - [path/side #..Side] - [path/member #..Member] - ) - -(do-template [ ] - [(template: #export ( content) - (.<| #..Access - - - content))] - - [side/left #..Side #.Left] - [side/right #..Side #.Right] - [member/left #..Member #.Left] - [member/right #..Member #.Right] - ) - -(do-template [ ] - [(template: #export ( content) - ( content))] - - [path/bind #..Bind] - [path/then #..Then] - ) - -(do-template [ ] - [(template: #export ( left right) - ( [left right]))] - - [path/alt #..Alt] - [path/seq #..Seq] - ) - -(type: #export Abstraction - (Abstraction' Synthesis)) - -(type: #export Apply - (Apply' Synthesis)) - -(def: #export unit Text "") - -(do-template [ ] - [(def: #export ( value) - (-> (All [a] (-> (Operation a) (Operation a)))) - (extension.temporary (set@ value)))] - - [with-locals Nat #locals] - ) - -(def: #export (with-abstraction arity resolver) - (-> Arity Resolver - (All [a] (-> (Operation a) (Operation a)))) - (extension.with-state {#locals arity})) - -(do-template [ ] - [(def: #export - (Operation ) - (extension.read (get@ )))] - - [locals #locals Nat] - ) - -(def: #export with-new-local - (All [a] (-> (Operation a) (Operation a))) - (<<| (do //.monad - [locals ..locals]) - (..with-locals (inc locals)))) - -(do-template [ ] - [(template: #export ( content) - (#..Primitive ( content)))] - - [bit #..Bit] - [i64 #..I64] - [f64 #..F64] - [text #..Text] - ) - -(do-template [ ] - [(template: #export ( content) - (<| #..Structure - - content))] - - [variant #analysis.Variant] - [tuple #analysis.Tuple] - ) - -(do-template [ ] - [(template: #export ( content) - (.<| #..Reference - - content))] - - [variable/local reference.local] - [variable/foreign reference.foreign] - ) - -(do-template [ ] - [(template: #export ( content) - (.<| #..Reference - - content))] - - [variable reference.variable] - [constant reference.constant] - ) - -(do-template [ ] - [(template: #export ( content) - (.<| #..Control - - - content))] - - [branch/case #..Branch #..Case] - [branch/let #..Branch #..Let] - [branch/if #..Branch #..If] - - [loop/recur #..Loop #..Recur] - [loop/scope #..Loop #..Scope] - - [function/abstraction #..Function #..Abstraction] - [function/apply #..Function #..Apply] - ) - -(def: #export (%path' %then value) - (All [a] (-> (Format a) (Format (Path' a)))) - (case value - #Pop - "_" - - (#Test primitive) - (format "(? " - (case primitive - (#Bit value) - (%b value) - - (#I64 value) - (%i (.int value)) - - (#F64 value) - (%f value) - - (#Text value) - (%t value)) - ")") - - (#Access access) - (case access - (#Side side) - (case side - (#.Left lefts) - (format "(" (%n lefts) " #0" ")") - - (#.Right lefts) - (format "(" (%n lefts) " #1" ")")) - - (#Member member) - (case member - (#.Left lefts) - (format "[" (%n lefts) " #0" "]") - - (#.Right lefts) - (format "[" (%n lefts) " #1" "]"))) + [/ + ["/." function] + ["/." case] + ["." // ("#/." monad) + ["//." extension] + [// + ["." reference] + ["." analysis (#+ Analysis)] + ["/" synthesis (#+ Synthesis Phase)]]]]) + +(def: (primitive analysis) + (-> analysis.Primitive /.Primitive) + (case analysis + #analysis.Unit + (#/.Text /.unit) - (#Bind register) - (format "(@ " (%n register) ")") - - (#Alt left right) - (format "(| " (%path' %then left) " " (%path' %then right) ")") - - (#Seq left right) - (format "(& " (%path' %then left) " " (%path' %then right) ")") - - (#Then then) - (|> (%then then) - (text.enclose ["(! " ")"])))) - -(def: #export (%synthesis value) - (Format Synthesis) - (case value - (#Primitive primitive) - (case primitive - (^template [ ] - ( value) - ( value)) - ([#Bit %b] - [#F64 %f] - [#Text %t]) - - (#I64 value) - (%i (.int value))) - - (#Structure structure) + (^template [ ] + ( value) + ( value)) + ([#analysis.Bit #/.Bit] + [#analysis.Frac #/.F64] + [#analysis.Text #/.Text]) + + (^template [ ] + ( value) + ( (.i64 value))) + ([#analysis.Nat #/.I64] + [#analysis.Int #/.I64] + [#analysis.Rev #/.I64]))) + +(def: #export (phase analysis) + Phase + (case analysis + (#analysis.Primitive analysis') + (///wrap (#/.Primitive (..primitive analysis'))) + + (#analysis.Structure structure) (case structure - (#analysis.Variant [lefts right? content]) - (|> (%synthesis content) - (format (%n lefts) " " (%b right?) " ") - (text.enclose ["(" ")"])) - - (#analysis.Tuple members) - (|> members - (list/map %synthesis) - (text.join-with " ") - (text.enclose ["[" "]"]))) - - (#Reference reference) - (|> reference - reference.%reference - (text.enclose ["(#@ " ")"])) - - (#Control control) - (case control - (#Function function) - (case function - (#Abstraction [environment arity body]) - (|> (%synthesis body) - (format (%n arity) " ") - (format (|> environment - (list/map reference.%variable) - (text.join-with " ") - (text.enclose ["[" "]"])) - " ") - (text.enclose ["(" ")"])) - - (#Apply func args) - (|> (list/map %synthesis args) - (text.join-with " ") - (format (%synthesis func) " ") - (text.enclose ["(" ")"]))) - - (#Branch branch) - (case branch - (#Let input register body) - (|> (format (%synthesis input) " " (%n register) " " (%synthesis body)) - (text.enclose ["(#let " ")"])) - - (#If test then else) - (|> (format (%synthesis test) " " (%synthesis then) " " (%synthesis else)) - (text.enclose ["(#if " ")"])) - - (#Case input path) - (|> (format (%synthesis input) " " (%path' %synthesis path)) - (text.enclose ["(#case " ")"]))) - - ## (#Loop loop) - _ - "???") - - (#Extension [name args]) - (|> (list/map %synthesis args) - (text.join-with " ") - (format (%t name)) - (text.enclose ["(" ")"])))) - -(def: #export %path - (Format Path) - (%path' %synthesis)) - -(structure: #export primitive-equivalence (Equivalence Primitive) - (def: (= reference sample) - (case [reference sample] - (^template [ ] - [( reference') ( sample')] - ( reference' sample')) - ([#Bit bit/= %b] - [#F64 f/= %f] - [#Text text/= %t]) - - [(#I64 reference') (#I64 sample')] - (i/= (.int reference') (.int sample')) - - _ - false))) - -(structure: #export access-equivalence (Equivalence Access) - (def: (= reference sample) - (case [reference sample] - (^template [] - [( reference') ( sample')] - (case [reference' sample'] - (^template [] - [( reference'') ( sample'')] - (n/= reference'' sample'')) - ([#.Left] - [#.Right]) - - _ - false)) - ([#Side] - [#Member]) - - _ - false))) - -(structure: #export (path'-equivalence Equivalence) - (All [a] (-> (Equivalence a) (Equivalence (Path' a)))) - - (def: (= reference sample) - (case [reference sample] - [#Pop #Pop] - true - - (^template [ ] - [( reference') ( sample')] - (:: = reference' sample')) - ([#Test primitive-equivalence] - [#Access access-equivalence] - [#Then Equivalence]) - - [(#Bind reference') (#Bind sample')] - (n/= reference' sample') - - (^template [] - [( leftR rightR) ( leftS rightS)] - (and (= leftR leftS) - (= rightR rightS))) - ([#Alt] - [#Seq]) - - _ - false))) - -(structure: #export equivalence (Equivalence Synthesis) - (def: (= reference sample) - (case [reference sample] - (^template [ ] - [( reference') ( sample')] - (:: = reference' sample')) - ([#Primitive primitive-equivalence]) - - _ - false))) - -(def: #export path-equivalence - (Equivalence Path) - (path'-equivalence equivalence)) + (#analysis.Variant variant) + (do //.monad + [valueS (phase (get@ #analysis.value variant))] + (wrap (/.variant (set@ #analysis.value valueS variant)))) + + (#analysis.Tuple tuple) + (|> tuple + (monad.map //.monad phase) + (///map (|>> /.tuple)))) + + (#analysis.Reference reference) + (///wrap (#/.Reference reference)) + + (#analysis.Case inputA branchesAB+) + (/case.synthesize phase inputA branchesAB+) + + (^ (analysis.no-op value)) + (phase value) + + (#analysis.Apply _) + (/function.apply phase analysis) + + (#analysis.Function environmentA bodyA) + (/function.abstraction phase environmentA bodyA) + + (#analysis.Extension name args) + (function (_ state) + (|> (//extension.apply phase [name args]) + (//.run' state) + (case> (#error.Success output) + (#error.Success output) + + (#error.Failure error) + (<| (//.run' state) + (do //.monad + [argsS+ (monad.map @ phase args)] + (wrap (#/.Extension [name argsS+]))))))) + + _ + (///wrap (undefined)) + )) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux index fe28c26df..94a2637fe 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux @@ -13,16 +13,15 @@ ["." frac ("#/." equivalence)]] [collection ["." list ("#/." fold monoid)]]]] - ["." // (#+ Path Synthesis Operation Phase) - ["." function] - ["/." // ("#/." monad) - [// - ["." reference] - ["." analysis (#+ Pattern Match Analysis)]]]]) + ["." /// ("#/." monad) + [// + ["." reference] + ["." analysis (#+ Pattern Match Analysis)] + ["/" synthesis (#+ Path Synthesis Operation Phase)]]]) (def: clean-up (-> Path Path) - (|>> (#//.Seq #//.Pop))) + (|>> (#/.Seq #/.Pop))) (def: (path' pattern end? thenC) (-> Pattern Bit (Operation Path) (Operation Path)) @@ -34,24 +33,24 @@ (^template [ ] ( value) - (////map (|>> (#//.Seq (#//.Test (|> value )))) + (////map (|>> (#/.Seq (#/.Test (|> value )))) thenC)) - ([#analysis.Bit #//.Bit] - [#analysis.Nat (<| #//.I64 .i64)] - [#analysis.Int (<| #//.I64 .i64)] - [#analysis.Rev (<| #//.I64 .i64)] - [#analysis.Frac #//.F64] - [#analysis.Text #//.Text])) + ([#analysis.Bit #/.Bit] + [#analysis.Nat (<| #/.I64 .i64)] + [#analysis.Int (<| #/.I64 .i64)] + [#analysis.Rev (<| #/.I64 .i64)] + [#analysis.Frac #/.F64] + [#analysis.Text #/.Text])) (#analysis.Bind register) - (<| (:: ///.monad map (|>> (#//.Seq (#//.Bind register)))) - //.with-new-local + (<| (:: ///.monad map (|>> (#/.Seq (#/.Bind register)))) + /.with-new-local thenC) (#analysis.Complex (#analysis.Variant [lefts right? value-pattern])) - (<| (////map (|>> (#//.Seq (#//.Access (#//.Side (if right? - (#.Right lefts) - (#.Left lefts))))))) + (<| (////map (|>> (#/.Seq (#/.Access (#/.Side (if right? + (#.Right lefts) + (#.Left lefts))))))) (path' value-pattern end?) (when> [(new> (not end?) [])] [(////map ..clean-up)]) thenC) @@ -61,9 +60,9 @@ (list/fold (function (_ [tuple::lefts tuple::member] nextC) (let [right? (n/= tuple::last tuple::lefts) end?' (and end? right?)] - (<| (////map (|>> (#//.Seq (#//.Access (#//.Member (if right? - (#.Right (dec tuple::lefts)) - (#.Left tuple::lefts))))))) + (<| (////map (|>> (#/.Seq (#/.Access (#/.Member (if right? + (#.Right (dec tuple::lefts)) + (#.Left tuple::lefts))))))) (path' tuple::member end?') (when> [(new> (not end?') [])] [(////map ..clean-up)]) nextC))) @@ -73,47 +72,47 @@ (def: #export (path synthesize pattern bodyA) (-> Phase Pattern Analysis (Operation Path)) - (path' pattern true (////map (|>> #//.Then) (synthesize bodyA)))) + (path' pattern true (////map (|>> #/.Then) (synthesize bodyA)))) (def: #export (weave leftP rightP) (-> Path Path Path) - (with-expansions [ (as-is (#//.Alt leftP rightP))] + (with-expansions [ (as-is (#/.Alt leftP rightP))] (case [leftP rightP] - [(#//.Seq preL postL) - (#//.Seq preR postR)] + [(#/.Seq preL postL) + (#/.Seq preR postR)] (case (weave preL preR) - (#//.Alt _) + (#/.Alt _) weavedP - (#//.Seq weavedP (weave postL postR))) + (#/.Seq weavedP (weave postL postR))) - [#//.Pop #//.Pop] + [#/.Pop #/.Pop] rightP (^template [ ] - [(#//.Test ( leftV)) - (#//.Test ( rightV))] + [(#/.Test ( leftV)) + (#/.Test ( rightV))] (if ( leftV rightV) rightP )) - ([#//.Bit bit/=] - [#//.I64 "lux i64 ="] - [#//.F64 frac/=] - [#//.Text text/=]) + ([#/.Bit bit/=] + [#/.I64 "lux i64 ="] + [#/.F64 frac/=] + [#/.Text text/=]) (^template [ ] - [(#//.Access ( ( leftL))) - (#//.Access ( ( rightL)))] + [(#/.Access ( ( leftL))) + (#/.Access ( ( rightL)))] (if (n/= leftL rightL) rightP )) - ([#//.Side #.Left] - [#//.Side #.Right] - [#//.Member #.Left] - [#//.Member #.Right]) + ([#/.Side #.Left] + [#/.Side #.Right] + [#/.Member #.Left] + [#/.Member #.Right]) - [(#//.Bind leftR) (#//.Bind rightR)] + [(#/.Bind leftR) (#/.Bind rightR)] (if (n/= leftR rightR) rightP ) @@ -138,9 +137,9 @@ _ (do @ - [headB/bodyS (//.with-new-local + [headB/bodyS (/.with-new-local (synthesize^ headB/bodyA))] - (wrap (//.branch/let [inputS inputR headB/bodyS]))))) + (wrap (/.branch/let [inputS inputR headB/bodyS]))))) (as-is (^or (^ [[(analysis.pattern/bit #1) thenA] @@ -150,7 +149,7 @@ (do @ [thenS (synthesize^ thenA) elseS (synthesize^ elseA)] - (wrap (//.branch/if [inputS thenS elseS])))) + (wrap (/.branch/if [inputS thenS elseS])))) (as-is _ @@ -164,7 +163,7 @@ (do @ [lastSP (path synthesize^ lastP lastA) prevsSP+ (monad.map @ (product.uncurry (path synthesize^)) prevsPA)] - (wrap (//.branch/case [inputS (list/fold weave lastSP prevsSP+)])))))] + (wrap (/.branch/case [inputS (list/fold weave lastSP prevsSP+)])))))] (case [headB tailB+] diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux deleted file mode 100644 index 29fe623ba..000000000 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux +++ /dev/null @@ -1,89 +0,0 @@ -(.module: - [lux (#- primitive) - [control - ["." monad (#+ do)] - [pipe (#+ case>)]] - [data - ["." maybe] - ["." error] - [collection - ["." list ("#/." functor)] - ["." dictionary (#+ Dictionary)]]]] - ["." // (#+ Synthesis Phase) - ["." function] - ["." case] - ["/." // ("#/." monad) - ["." extension] - [// - ["." reference] - ["." analysis (#+ Analysis)]]]]) - -(def: (primitive analysis) - (-> analysis.Primitive //.Primitive) - (case analysis - #analysis.Unit - (#//.Text //.unit) - - (^template [ ] - ( value) - ( value)) - ([#analysis.Bit #//.Bit] - [#analysis.Frac #//.F64] - [#analysis.Text #//.Text]) - - (^template [ ] - ( value) - ( (.i64 value))) - ([#analysis.Nat #//.I64] - [#analysis.Int #//.I64] - [#analysis.Rev #//.I64]))) - -(def: #export (phase analysis) - Phase - (case analysis - (#analysis.Primitive analysis') - (////wrap (#//.Primitive (..primitive analysis'))) - - (#analysis.Structure structure) - (case structure - (#analysis.Variant variant) - (do ///.monad - [valueS (phase (get@ #analysis.value variant))] - (wrap (//.variant (set@ #analysis.value valueS variant)))) - - (#analysis.Tuple tuple) - (|> tuple - (monad.map ///.monad phase) - (////map (|>> //.tuple)))) - - (#analysis.Reference reference) - (////wrap (#//.Reference reference)) - - (#analysis.Case inputA branchesAB+) - (case.synthesize phase inputA branchesAB+) - - (^ (analysis.no-op value)) - (phase value) - - (#analysis.Apply _) - (function.apply phase analysis) - - (#analysis.Function environmentA bodyA) - (function.abstraction phase environmentA bodyA) - - (#analysis.Extension name args) - (function (_ state) - (|> (extension.apply phase [name args]) - (///.run' state) - (case> (#error.Success output) - (#error.Success output) - - (#error.Failure error) - (<| (///.run' state) - (do ///.monad - [argsS+ (monad.map @ phase args)] - (wrap (#//.Extension [name argsS+]))))))) - - _ - (////wrap (undefined)) - )) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux index a741238ab..b5c97e825 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux @@ -10,12 +10,13 @@ [collection ["." list ("#/." functor monoid fold)] ["dict" dictionary (#+ Dictionary)]]]] - ["." // (#+ Path Synthesis Operation Phase) - ["." loop (#+ Transform)] + [// + ["//." loop (#+ Transform)] ["/." // ("#/." monad) [// ["." reference (#+ Register Variable)] - ["." analysis (#+ Environment Arity Analysis)]]]]) + ["." analysis (#+ Environment Arity Analysis)] + ["/" synthesis (#+ Path Synthesis Operation Phase)]]]]) (exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment}) (ex.report ["Foreign" (%n foreign)] @@ -27,14 +28,14 @@ (-> Arity (List Synthesis)) (|>> dec (list.n/range 1) - (list/map (|>> //.variable/local)))) + (list/map (|>> /.variable/local)))) (template: #export (self-reference) - (//.variable/local 0)) + (/.variable/local 0)) (def: (expanded-nested-self-reference arity) (-> Arity Synthesis) - (//.function/apply [(..self-reference) (arity-arguments arity)])) + (/.function/apply [(..self-reference) (arity-arguments arity)])) (def: #export (apply phase) (-> Phase Phase) @@ -43,17 +44,17 @@ (do ///.monad [funcS (phase funcA) argsS (monad.map @ phase argsA) - ## locals //.locals + ## locals /.locals ] - (with-expansions [ (as-is (//.function/apply [funcS argsS]))] + (with-expansions [ (as-is (/.function/apply [funcS argsS]))] (case funcS - ## (^ (//.function/abstraction functionS)) + ## (^ (/.function/abstraction functionS)) ## (wrap (|> functionS - ## (loop.loop (get@ #//.environment functionS) locals argsS) + ## (//loop.loop (get@ #/.environment functionS) locals argsS) ## (maybe.default ))) - (^ (//.function/apply [funcS' argsS'])) - (wrap (//.function/apply [funcS' (list/compose argsS' argsS)])) + (^ (/.function/apply [funcS' argsS'])) + (wrap (/.function/apply [funcS' (list/compose argsS' argsS)])) _ (wrap ))))))) @@ -70,8 +71,8 @@ (def: (grow-path grow path) (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) (case path - (#//.Bind register) - (////wrap (#//.Bind (inc register))) + (#/.Bind register) + (////wrap (#/.Bind (inc register))) (^template [] ( left right) @@ -79,12 +80,12 @@ [left' (grow-path grow left) right' (grow-path grow right)] (wrap ( left' right')))) - ([#//.Alt] [#//.Seq]) + ([#/.Alt] [#/.Seq]) - (#//.Then thenS) + (#/.Then thenS) (|> thenS grow - (////map (|>> #//.Then))) + (////map (|>> #/.Then))) _ (////wrap path))) @@ -104,95 +105,95 @@ (def: (grow environment expression) (-> Environment Synthesis (Operation Synthesis)) (case expression - (#//.Structure structure) + (#/.Structure structure) (case structure (#analysis.Variant [lefts right? subS]) (|> subS (grow environment) - (////map (|>> [lefts right?] //.variant))) + (////map (|>> [lefts right?] /.variant))) (#analysis.Tuple membersS+) (|> membersS+ (monad.map ///.monad (grow environment)) - (////map (|>> //.tuple)))) + (////map (|>> /.tuple)))) (^ (..self-reference)) - (////wrap (//.function/apply [expression (list (//.variable/local 1))])) + (////wrap (/.function/apply [expression (list (/.variable/local 1))])) - (#//.Reference reference) + (#/.Reference reference) (case reference (#reference.Variable variable) (case variable (#reference.Local register) - (////wrap (//.variable/local (inc register))) + (////wrap (/.variable/local (inc register))) (#reference.Foreign register) (|> register (find-foreign environment) - (////map (|>> //.variable)))) + (////map (|>> /.variable)))) (#reference.Constant constant) (////wrap expression)) - (#//.Control control) + (#/.Control control) (case control - (#//.Branch branch) + (#/.Branch branch) (case branch - (#//.Let [inputS register bodyS]) + (#/.Let [inputS register bodyS]) (do ///.monad [inputS' (grow environment inputS) bodyS' (grow environment bodyS)] - (wrap (//.branch/let [inputS' (inc register) bodyS']))) + (wrap (/.branch/let [inputS' (inc register) bodyS']))) - (#//.If [testS thenS elseS]) + (#/.If [testS thenS elseS]) (do ///.monad [testS' (grow environment testS) thenS' (grow environment thenS) elseS' (grow environment elseS)] - (wrap (//.branch/if [testS' thenS' elseS']))) + (wrap (/.branch/if [testS' thenS' elseS']))) - (#//.Case [inputS pathS]) + (#/.Case [inputS pathS]) (do ///.monad [inputS' (grow environment inputS) pathS' (grow-path (grow environment) pathS)] - (wrap (//.branch/case [inputS' pathS'])))) + (wrap (/.branch/case [inputS' pathS'])))) - (#//.Loop loop) + (#/.Loop loop) (case loop - (#//.Scope [start initsS+ iterationS]) + (#/.Scope [start initsS+ iterationS]) (do ///.monad [initsS+' (monad.map @ (grow environment) initsS+) iterationS' (grow environment iterationS)] - (wrap (//.loop/scope [start initsS+' iterationS']))) + (wrap (/.loop/scope [start initsS+' iterationS']))) - (#//.Recur argumentsS+) + (#/.Recur argumentsS+) (|> argumentsS+ (monad.map ///.monad (grow environment)) - (////map (|>> //.loop/recur)))) + (////map (|>> /.loop/recur)))) - (#//.Function function) + (#/.Function function) (case function - (#//.Abstraction [_env _arity _body]) + (#/.Abstraction [_env _arity _body]) (do ///.monad [_env' (grow-sub-environment environment _env)] - (wrap (//.function/abstraction [_env' _arity _body]))) + (wrap (/.function/abstraction [_env' _arity _body]))) - (#//.Apply funcS argsS+) + (#/.Apply funcS argsS+) (case funcS - (^ (//.function/apply [(..self-reference) pre-argsS+])) - (////wrap (//.function/apply [(..self-reference) - (list/compose pre-argsS+ argsS+)])) + (^ (/.function/apply [(..self-reference) pre-argsS+])) + (////wrap (/.function/apply [(..self-reference) + (list/compose pre-argsS+ argsS+)])) _ (do ///.monad [funcS' (grow environment funcS) argsS+' (monad.map @ (grow environment) argsS+)] - (wrap (//.function/apply [funcS' argsS+'])))))) + (wrap (/.function/apply [funcS' argsS+'])))))) - (#//.Extension name argumentsS+) + (#/.Extension name argumentsS+) (|> argumentsS+ (monad.map ///.monad (grow environment)) - (////map (|>> (#//.Extension name)))) + (////map (|>> (#/.Extension name)))) _ (////wrap expression))) @@ -202,10 +203,10 @@ (do ///.monad [bodyS (phase bodyA)] (case bodyS - (^ (//.function/abstraction [env' down-arity' bodyS'])) + (^ (/.function/abstraction [env' down-arity' bodyS'])) (|> bodyS' (grow env') - (:: @ map (|>> [environment (inc down-arity')] //.function/abstraction))) + (:: @ map (|>> [environment (inc down-arity')] /.function/abstraction))) _ - (wrap (//.function/abstraction [environment 1 bodyS]))))) + (wrap (/.function/abstraction [environment 1 bodyS]))))) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux index 8e0d51cd8..ecf13440b 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux @@ -10,12 +10,13 @@ [macro ["." code] ["." syntax]]] - ["." // (#+ Path Abstraction Synthesis) + [/// + ## TODO: Remove the 'extension' import ASAP. + ["///." extension] [// - ["." extension] - [// - ["." reference (#+ Register Variable)] - ["." analysis (#+ Environment)]]]]) + ["." reference (#+ Register Variable)] + ["." analysis (#+ Environment)] + ["/" synthesis (#+ Path Abstraction Synthesis)]]]) (type: #export (Transform a) (-> a (Maybe a))) @@ -27,10 +28,10 @@ #.None #0)) (template: #export (self) - (#//.Reference (reference.local 0))) + (#/.Reference (reference.local 0))) (template: (recursive-apply args) - (#//.Apply (self) args)) + (#/.Apply (self) args)) (def: improper #0) (def: proper #1) @@ -41,7 +42,7 @@ (^ (self)) improper - (#//.Structure structure) + (#/.Structure structure) (case structure (#analysis.Variant variantS) (proper? (get@ #analysis.value variantS)) @@ -49,51 +50,51 @@ (#analysis.Tuple membersS+) (list.every? proper? membersS+)) - (#//.Control controlS) + (#/.Control controlS) (case controlS - (#//.Branch branchS) + (#/.Branch branchS) (case branchS - (#//.Case inputS pathS) + (#/.Case inputS pathS) (and (proper? inputS) (.loop [pathS pathS] (case pathS - (^or (#//.Alt leftS rightS) (#//.Seq leftS rightS)) + (^or (#/.Alt leftS rightS) (#/.Seq leftS rightS)) (and (recur leftS) (recur rightS)) - (#//.Then bodyS) + (#/.Then bodyS) (proper? bodyS) _ proper))) - (#//.Let inputS register bodyS) + (#/.Let inputS register bodyS) (and (proper? inputS) (proper? bodyS)) - (#//.If inputS thenS elseS) + (#/.If inputS thenS elseS) (and (proper? inputS) (proper? thenS) (proper? elseS))) - (#//.Loop loopS) + (#/.Loop loopS) (case loopS - (#//.Scope scopeS) - (and (list.every? proper? (get@ #//.inits scopeS)) - (proper? (get@ #//.iteration scopeS))) + (#/.Scope scopeS) + (and (list.every? proper? (get@ #/.inits scopeS)) + (proper? (get@ #/.iteration scopeS))) - (#//.Recur argsS) + (#/.Recur argsS) (list.every? proper? argsS)) - (#//.Function functionS) + (#/.Function functionS) (case functionS - (#//.Abstraction environment arity bodyS) + (#/.Abstraction environment arity bodyS) (list.every? reference.self? environment) - (#//.Apply funcS argsS) + (#/.Apply funcS argsS) (and (proper? funcS) (list.every? proper? argsS)))) - (#//.Extension [name argsS]) + (#/.Extension [name argsS]) (list.every? proper? argsS) _ @@ -103,20 +104,20 @@ (-> (Transform Synthesis) (Transform Path)) (function (recur pathS) (case pathS - (#//.Alt leftS rightS) + (#/.Alt leftS rightS) (let [leftS' (recur leftS) rightS' (recur rightS)] (if (or (some? leftS') (some? rightS')) - (#.Some (#//.Alt (maybe.default leftS leftS') - (maybe.default rightS rightS'))) + (#.Some (#/.Alt (maybe.default leftS leftS') + (maybe.default rightS rightS'))) #.None)) - (#//.Seq leftS rightS) - (maybe/map (|>> (#//.Seq leftS)) (recur rightS)) + (#/.Seq leftS rightS) + (maybe/map (|>> (#/.Seq leftS)) (recur rightS)) - (#//.Then bodyS) - (maybe/map (|>> #//.Then) (synthesis-recursion bodyS)) + (#/.Then bodyS) + (maybe/map (|>> #/.Then) (synthesis-recursion bodyS)) _ #.None))) @@ -125,33 +126,33 @@ (-> Nat (Transform Synthesis)) (function (recur exprS) (case exprS - (#//.Control controlS) + (#/.Control controlS) (case controlS - (#//.Branch branchS) + (#/.Branch branchS) (case branchS - (#//.Case inputS pathS) + (#/.Case inputS pathS) (|> pathS (path-recursion recur) - (maybe/map (|>> (#//.Case inputS) #//.Branch #//.Control))) + (maybe/map (|>> (#/.Case inputS) #/.Branch #/.Control))) - (#//.Let inputS register bodyS) - (maybe/map (|>> (#//.Let inputS register) #//.Branch #//.Control) + (#/.Let inputS register bodyS) + (maybe/map (|>> (#/.Let inputS register) #/.Branch #/.Control) (recur bodyS)) - (#//.If inputS thenS elseS) + (#/.If inputS thenS elseS) (let [thenS' (recur thenS) elseS' (recur elseS)] (if (or (some? thenS') (some? elseS')) - (#.Some (|> (#//.If inputS - (maybe.default thenS thenS') - (maybe.default elseS elseS')) - #//.Branch #//.Control)) + (#.Some (|> (#/.If inputS + (maybe.default thenS thenS') + (maybe.default elseS elseS')) + #/.Branch #/.Control)) #.None))) - (^ (#//.Function (recursive-apply argsS))) + (^ (#/.Function (recursive-apply argsS))) (if (n/= arity (list.size argsS)) - (#.Some (|> argsS #//.Recur #//.Loop #//.Control)) + (#.Some (|> argsS #/.Recur #/.Loop #/.Control)) #.None) _ @@ -174,8 +175,8 @@ (-> (Transform Synthesis) Register (Transform Path)) (function (recur pathS) (case pathS - (#//.Bind register) - (#.Some (#//.Bind (n/+ offset register))) + (#/.Bind register) + (#.Some (#/.Bind (n/+ offset register))) (^template [] ( leftS rightS) @@ -183,10 +184,10 @@ [leftS' (recur leftS) rightS' (recur rightS)] (wrap ( leftS' rightS')))) - ([#//.Alt] [#//.Seq]) + ([#/.Alt] [#/.Seq]) - (#//.Then bodyS) - (|> bodyS adjust-synthesis (maybe/map (|>> #//.Then))) + (#/.Then bodyS) + (|> bodyS adjust-synthesis (maybe/map (|>> #/.Then))) _ (#.Some pathS)))) @@ -195,7 +196,7 @@ (-> Environment Register (Transform Synthesis)) (function (recur exprS) (case exprS - (#//.Structure structureS) + (#/.Structure structureS) (case structureS (#analysis.Variant variantS) (do maybe.monad @@ -203,89 +204,89 @@ (wrap (|> variantS (set@ #analysis.value valueS') #analysis.Variant - #//.Structure))) + #/.Structure))) (#analysis.Tuple membersS+) (|> membersS+ (monad.map maybe.monad recur) - (maybe/map (|>> #analysis.Tuple #//.Structure)))) + (maybe/map (|>> #analysis.Tuple #/.Structure)))) - (#//.Reference reference) + (#/.Reference reference) (case reference (^ (reference.constant constant)) (#.Some exprS) (^ (reference.local register)) - (#.Some (#//.Reference (reference.local (n/+ offset register)))) + (#.Some (#/.Reference (reference.local (n/+ offset register)))) (^ (reference.foreign register)) (|> scope-environment (list.nth register) - (maybe/map (|>> #reference.Variable #//.Reference)))) + (maybe/map (|>> #reference.Variable #/.Reference)))) - (^ (//.branch/case [inputS pathS])) + (^ (/.branch/case [inputS pathS])) (do maybe.monad [inputS' (recur inputS) pathS' (adjust-path recur offset pathS)] - (wrap (|> pathS' [inputS'] //.branch/case))) + (wrap (|> pathS' [inputS'] /.branch/case))) - (^ (//.branch/let [inputS register bodyS])) + (^ (/.branch/let [inputS register bodyS])) (do maybe.monad [inputS' (recur inputS) bodyS' (recur bodyS)] - (wrap (//.branch/let [inputS' register bodyS']))) + (wrap (/.branch/let [inputS' register bodyS']))) - (^ (//.branch/if [inputS thenS elseS])) + (^ (/.branch/if [inputS thenS elseS])) (do maybe.monad [inputS' (recur inputS) thenS' (recur thenS) elseS' (recur elseS)] - (wrap (//.branch/if [inputS' thenS' elseS']))) + (wrap (/.branch/if [inputS' thenS' elseS']))) - (^ (//.loop/scope scopeS)) + (^ (/.loop/scope scopeS)) (do maybe.monad [inits' (|> scopeS - (get@ #//.inits) + (get@ #/.inits) (monad.map maybe.monad recur)) - iteration' (recur (get@ #//.iteration scopeS))] - (wrap (//.loop/scope {#//.start (|> scopeS (get@ #//.start) (n/+ offset)) - #//.inits inits' - #//.iteration iteration'}))) + iteration' (recur (get@ #/.iteration scopeS))] + (wrap (/.loop/scope {#/.start (|> scopeS (get@ #/.start) (n/+ offset)) + #/.inits inits' + #/.iteration iteration'}))) - (^ (//.loop/recur argsS)) + (^ (/.loop/recur argsS)) (|> argsS (monad.map maybe.monad recur) - (maybe/map (|>> //.loop/recur))) + (maybe/map (|>> /.loop/recur))) - (^ (//.function/abstraction [environment arity bodyS])) + (^ (/.function/abstraction [environment arity bodyS])) (do maybe.monad [environment' (monad.map maybe.monad (resolve scope-environment) environment)] - (wrap (//.function/abstraction [environment' arity bodyS]))) + (wrap (/.function/abstraction [environment' arity bodyS]))) - (^ (//.function/apply [function arguments])) + (^ (/.function/apply [function arguments])) (do maybe.monad [function' (recur function) arguments' (monad.map maybe.monad recur arguments)] - (wrap (//.function/apply [function' arguments']))) + (wrap (/.function/apply [function' arguments']))) - (#//.Extension [name argsS]) + (#/.Extension [name argsS]) (|> argsS (monad.map maybe.monad recur) - (maybe/map (|>> [name] #//.Extension))) + (maybe/map (|>> [name] #/.Extension))) _ (#.Some exprS)))) (def: #export (loop environment num-locals inits functionS) (-> Environment Nat (List Synthesis) Abstraction (Maybe Synthesis)) - (let [bodyS (get@ #//.body functionS)] + (let [bodyS (get@ #/.body functionS)] (if (and (n/= (list.size inits) - (get@ #//.arity functionS)) + (get@ #/.arity functionS)) (proper? bodyS)) (|> bodyS (adjust environment num-locals) - (maybe/map (|>> [(inc num-locals) inits] //.loop/scope))) + (maybe/map (|>> [(inc num-locals) inits] /.loop/scope))) #.None))) diff --git a/stdlib/source/lux/tool/compiler/phase/translation.lux b/stdlib/source/lux/tool/compiler/phase/translation.lux index 6ee7f3841..99a4c5517 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation.lux @@ -1,8 +1,8 @@ (.module: [lux #* [control - ["ex" exception (#+ exception:)] - [monad (#+ do)]] + [monad (#+ do)] + ["." exception (#+ exception:)]] [data ["." product] ["." error (#+ Error)] @@ -15,8 +15,9 @@ [world [file (#+ Path)]]] ["." // - [synthesis (#+ Synthesis)] - ["." extension]]) + ["." extension] + [// + [synthesis (#+ Synthesis)]]]) (do-template [] [(exception: #export () @@ -27,21 +28,25 @@ ) (exception: #export (cannot-interpret {error Text}) - (ex.report ["Error" error])) + (exception.report + ["Error" error])) (exception: #export (unknown-lux-name {name Name}) - (ex.report ["Name" (%name name)])) + (exception.report + ["Name" (%name name)])) (exception: #export (cannot-overwrite-lux-name {lux-name Name} {old-host-name Text} {new-host-name Text}) - (ex.report ["Lux Name" (%name lux-name)] - ["Old Host Name" old-host-name] - ["New Host Name" new-host-name])) + (exception.report + ["Lux Name" (%name lux-name)] + ["Old Host Name" old-host-name] + ["New Host Name" new-host-name])) (do-template [] [(exception: #export ( {name Name}) - (ex.report ["Output" (%name name)]))] + (exception.report + ["Output" (%name name)]))] [cannot-overwrite-output] [no-buffer-for-saving-code] @@ -141,7 +146,7 @@ (#error.Success [stateE output]) #.None - (ex.throw []))))] + (exception.throw []))))] [#anchor (with-anchor anchor) @@ -181,7 +186,7 @@ (#error.Success [state+ output]) (#error.Failure error) - (ex.throw cannot-interpret error))))] + (exception.throw cannot-interpret error))))] [evaluate! expression] [execute! statement] @@ -196,7 +201,7 @@ (#error.Success [stateE output]) (#error.Failure error) - (ex.throw cannot-interpret error)))) + (exception.throw cannot-interpret error)))) (def: #export (save! name code) (All [anchor expression statement] @@ -231,7 +236,7 @@ (#error.Success [stateE host-name]) #.None - (ex.throw unknown-lux-name lux-name))))) + (exception.throw unknown-lux-name lux-name))))) (def: #export (learn lux-name host-name) (All [anchor expression statement] @@ -247,4 +252,4 @@ []]) (#.Some old-host-name) - (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]))))) + (exception.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]))))) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux b/stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux index 7cd24b23d..af676ad85 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux @@ -9,8 +9,8 @@ [// ["/." // ["//." // ("#/." monad) - [synthesis (#+ Synthesis)] [// + [synthesis (#+ Synthesis)] ["." reference (#+ Register Variable Reference)]]]]]) (signature: #export (System expression) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux index 499486ff9..d989cb223 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux @@ -19,9 +19,9 @@ [common ["common-." reference]] ["//." // ("#/." monad) - ["." synthesis (#+ Synthesis Path)] [// - [reference (#+ Register)]]]]]) + [reference (#+ Register)] + ["." synthesis (#+ Synthesis Path)]]]]]) (def: #export register (common-reference.local _.var)) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/expression.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/expression.lux index 76b206124..822f51e35 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/expression.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/expression.lux @@ -11,8 +11,9 @@ ["." case] ["." loop] ["." /// - ["." synthesis] - ["." extension]]]) + ["." extension] + [// + ["." synthesis]]]]) (def: #export (translate synthesis) Phase diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/extension/common.lux index 3cf3fbc27..85bdb64ba 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/extension/common.lux @@ -19,9 +19,10 @@ ["///." runtime (#+ Operation Phase Handler Bundle)] ["///." primitive] ["//." /// - ["." synthesis (#+ Synthesis)] ["." extension - ["." bundle]]]]) + ["." bundle]] + [// + ["." synthesis (#+ Synthesis)]]]]) (syntax: (Vector {size s.nat} elemT) (wrap (list (` [(~+ (list.repeat size elemT))])))) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/extension/host.lux index 637cadc5f..8091f7fee 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/extension/host.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/extension/host.lux @@ -13,9 +13,10 @@ [// ["///." runtime (#+ Handler Bundle)] ["//." /// - ["." synthesis] ["." extension - ["." bundle]]]]]) + ["." bundle]] + [// + ["." synthesis]]]]]) (do-template [ ] [(def: ( _) Nullary )] diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux index 89536c579..5727b737d 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux @@ -19,10 +19,10 @@ [common ["common-." reference]] ["//." // ("#/." monad) - [synthesis (#+ Synthesis)] [// [reference (#+ Register Variable)] [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] + [synthesis (#+ Synthesis)] ["." name]]]]]) (def: #export (apply translate [functionS argsS+]) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux index 8d0cefe4e..cbb032153 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux @@ -16,7 +16,8 @@ ["//." case] ["/." // ["//." // - [synthesis (#+ Scope Synthesis)]]]]) + [// + [synthesis (#+ Scope Synthesis)]]]]]) (def: @scope (_.var "scope")) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux index e2014c064..5a37cb8ef 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux @@ -17,9 +17,9 @@ ["_" js (#+ Expression Var Computation Statement)]]] ["." /// ["//." // - ["." synthesis] [// - ["/////." name]]]] + ["/////." name] + ["." synthesis]]]] ) (do-template [ ] diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux index 8af864654..732f48bb9 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux @@ -8,9 +8,9 @@ ["//." runtime (#+ Operation Phase)] ["//." primitive] ["/." /// - ["." synthesis (#+ Synthesis)] [// - [analysis (#+ Variant Tuple)]]]]) + [analysis (#+ Variant Tuple)] + ["." synthesis (#+ Synthesis)]]]]) (def: #export (tuple translate elemsS+) (-> Phase (Tuple Synthesis) (Operation Expression)) diff --git a/stdlib/source/lux/tool/compiler/synthesis.lux b/stdlib/source/lux/tool/compiler/synthesis.lux new file mode 100644 index 000000000..a287caf5e --- /dev/null +++ b/stdlib/source/lux/tool/compiler/synthesis.lux @@ -0,0 +1,468 @@ +(.module: + [lux (#- i64 Scope) + [control + [monad (#+ do)] + [equivalence (#+ Equivalence)] + ["ex" exception (#+ exception:)]] + [data + ["." bit ("#/." equivalence)] + ["." text ("#/." equivalence) + format] + [collection + ["." list ("#/." functor)] + ["." dictionary (#+ Dictionary)]]]] + [// + ["//." reference (#+ Register Variable Reference)] + ["//." analysis (#+ Environment Arity Composite Analysis)] + ["." phase + ["." extension (#+ Extension)]]]) + +(type: #export Resolver (Dictionary Variable Variable)) + +(type: #export State + {#locals Nat}) + +(def: #export fresh-resolver + Resolver + (dictionary.new //reference.hash)) + +(def: #export init + State + {#locals 0}) + +(type: #export Primitive + (#Bit Bit) + (#I64 (I64 Any)) + (#F64 Frac) + (#Text Text)) + +(type: #export Side + (Either Nat Nat)) + +(type: #export Member + (Either Nat Nat)) + +(type: #export Access + (#Side Side) + (#Member Member)) + +(type: #export (Path' s) + #Pop + (#Test Primitive) + (#Access Access) + (#Bind Register) + (#Alt (Path' s) (Path' s)) + (#Seq (Path' s) (Path' s)) + (#Then s)) + +(type: #export (Abstraction' s) + {#environment Environment + #arity Arity + #body s}) + +(type: #export (Apply' s) + {#function s + #arguments (List s)}) + +(type: #export (Branch s) + (#Let s Register s) + (#If s s s) + (#Case s (Path' s))) + +(type: #export (Scope s) + {#start Register + #inits (List s) + #iteration s}) + +(type: #export (Loop s) + (#Scope (Scope s)) + (#Recur (List s))) + +(type: #export (Function s) + (#Abstraction (Abstraction' s)) + (#Apply s (List s))) + +(type: #export (Control s) + (#Branch (Branch s)) + (#Loop (Loop s)) + (#Function (Function s))) + +(type: #export #rec Synthesis + (#Primitive Primitive) + (#Structure (Composite Synthesis)) + (#Reference Reference) + (#Control (Control Synthesis)) + (#Extension (Extension Synthesis))) + +(do-template [ ] + [(type: #export + ( ..State Analysis Synthesis))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) + +(type: #export Path + (Path' Synthesis)) + +(def: #export path/pop + Path + #Pop) + +(do-template [ ] + [(template: #export ( content) + (#..Test ( content)))] + + [path/bit #..Bit] + [path/i64 #..I64] + [path/f64 #..F64] + [path/text #..Text] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Access + + content))] + + [path/side #..Side] + [path/member #..Member] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Access + + + content))] + + [side/left #..Side #.Left] + [side/right #..Side #.Right] + [member/left #..Member #.Left] + [member/right #..Member #.Right] + ) + +(do-template [ ] + [(template: #export ( content) + ( content))] + + [path/bind #..Bind] + [path/then #..Then] + ) + +(do-template [ ] + [(template: #export ( left right) + ( [left right]))] + + [path/alt #..Alt] + [path/seq #..Seq] + ) + +(type: #export Abstraction + (Abstraction' Synthesis)) + +(type: #export Apply + (Apply' Synthesis)) + +(def: #export unit Text "") + +(do-template [ ] + [(def: #export ( value) + (-> (All [a] (-> (Operation a) (Operation a)))) + (extension.temporary (set@ value)))] + + [with-locals Nat #locals] + ) + +(def: #export (with-abstraction arity resolver) + (-> Arity Resolver + (All [a] (-> (Operation a) (Operation a)))) + (extension.with-state {#locals arity})) + +(do-template [ ] + [(def: #export + (Operation ) + (extension.read (get@ )))] + + [locals #locals Nat] + ) + +(def: #export with-new-local + (All [a] (-> (Operation a) (Operation a))) + (<<| (do phase.monad + [locals ..locals]) + (..with-locals (inc locals)))) + +(do-template [ ] + [(template: #export ( content) + (#..Primitive ( content)))] + + [bit #..Bit] + [i64 #..I64] + [f64 #..F64] + [text #..Text] + ) + +(do-template [ ] + [(template: #export ( content) + (<| #..Structure + + content))] + + [variant #//analysis.Variant] + [tuple #//analysis.Tuple] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Reference + + content))] + + [variable/local //reference.local] + [variable/foreign //reference.foreign] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Reference + + content))] + + [variable //reference.variable] + [constant //reference.constant] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Control + + + content))] + + [branch/case #..Branch #..Case] + [branch/let #..Branch #..Let] + [branch/if #..Branch #..If] + + [loop/recur #..Loop #..Recur] + [loop/scope #..Loop #..Scope] + + [function/abstraction #..Function #..Abstraction] + [function/apply #..Function #..Apply] + ) + +(def: #export (%path' %then value) + (All [a] (-> (Format a) (Format (Path' a)))) + (case value + #Pop + "_" + + (#Test primitive) + (format "(? " + (case primitive + (#Bit value) + (%b value) + + (#I64 value) + (%i (.int value)) + + (#F64 value) + (%f value) + + (#Text value) + (%t value)) + ")") + + (#Access access) + (case access + (#Side side) + (case side + (#.Left lefts) + (format "(" (%n lefts) " #0" ")") + + (#.Right lefts) + (format "(" (%n lefts) " #1" ")")) + + (#Member member) + (case member + (#.Left lefts) + (format "[" (%n lefts) " #0" "]") + + (#.Right lefts) + (format "[" (%n lefts) " #1" "]"))) + + (#Bind register) + (format "(@ " (%n register) ")") + + (#Alt left right) + (format "(| " (%path' %then left) " " (%path' %then right) ")") + + (#Seq left right) + (format "(& " (%path' %then left) " " (%path' %then right) ")") + + (#Then then) + (|> (%then then) + (text.enclose ["(! " ")"])))) + +(def: #export (%synthesis value) + (Format Synthesis) + (case value + (#Primitive primitive) + (case primitive + (^template [ ] + ( value) + ( value)) + ([#Bit %b] + [#F64 %f] + [#Text %t]) + + (#I64 value) + (%i (.int value))) + + (#Structure structure) + (case structure + (#//analysis.Variant [lefts right? content]) + (|> (%synthesis content) + (format (%n lefts) " " (%b right?) " ") + (text.enclose ["(" ")"])) + + (#//analysis.Tuple members) + (|> members + (list/map %synthesis) + (text.join-with " ") + (text.enclose ["[" "]"]))) + + (#Reference reference) + (|> reference + //reference.%reference + (text.enclose ["(#@ " ")"])) + + (#Control control) + (case control + (#Function function) + (case function + (#Abstraction [environment arity body]) + (|> (%synthesis body) + (format (%n arity) " ") + (format (|> environment + (list/map //reference.%variable) + (text.join-with " ") + (text.enclose ["[" "]"])) + " ") + (text.enclose ["(" ")"])) + + (#Apply func args) + (|> (list/map %synthesis args) + (text.join-with " ") + (format (%synthesis func) " ") + (text.enclose ["(" ")"]))) + + (#Branch branch) + (case branch + (#Let input register body) + (|> (format (%synthesis input) " " (%n register) " " (%synthesis body)) + (text.enclose ["(#let " ")"])) + + (#If test then else) + (|> (format (%synthesis test) " " (%synthesis then) " " (%synthesis else)) + (text.enclose ["(#if " ")"])) + + (#Case input path) + (|> (format (%synthesis input) " " (%path' %synthesis path)) + (text.enclose ["(#case " ")"]))) + + ## (#Loop loop) + _ + "???") + + (#Extension [name args]) + (|> (list/map %synthesis args) + (text.join-with " ") + (format (%t name)) + (text.enclose ["(" ")"])))) + +(def: #export %path + (Format Path) + (%path' %synthesis)) + +(structure: #export primitive-equivalence (Equivalence Primitive) + (def: (= reference sample) + (case [reference sample] + (^template [ ] + [( reference') ( sample')] + ( reference' sample')) + ([#Bit bit/= %b] + [#F64 f/= %f] + [#Text text/= %t]) + + [(#I64 reference') (#I64 sample')] + (i/= (.int reference') (.int sample')) + + _ + false))) + +(structure: #export access-equivalence (Equivalence Access) + (def: (= reference sample) + (case [reference sample] + (^template [] + [( reference') ( sample')] + (case [reference' sample'] + (^template [] + [( reference'') ( sample'')] + (n/= reference'' sample'')) + ([#.Left] + [#.Right]) + + _ + false)) + ([#Side] + [#Member]) + + _ + false))) + +(structure: #export (path'-equivalence Equivalence) + (All [a] (-> (Equivalence a) (Equivalence (Path' a)))) + + (def: (= reference sample) + (case [reference sample] + [#Pop #Pop] + true + + (^template [ ] + [( reference') ( sample')] + (:: = reference' sample')) + ([#Test primitive-equivalence] + [#Access access-equivalence] + [#Then Equivalence]) + + [(#Bind reference') (#Bind sample')] + (n/= reference' sample') + + (^template [] + [( leftR rightR) ( leftS rightS)] + (and (= leftR leftS) + (= rightR rightS))) + ([#Alt] + [#Seq]) + + _ + false))) + +(structure: #export equivalence (Equivalence Synthesis) + (def: (= reference sample) + (case [reference sample] + (^template [ ] + [( reference') ( sample')] + (:: = reference' sample')) + ([#Primitive primitive-equivalence]) + + _ + false))) + +(def: #export path-equivalence + (Equivalence Path) + (path'-equivalence equivalence)) -- cgit v1.2.3