diff options
Diffstat (limited to '')
5 files changed, 298 insertions, 320 deletions
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux index c9bc95612..71009473a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux @@ -103,7 +103,7 @@ _ false))) -(structure: (composite-equivalence (^open "/@.")) +(structure: #export (composite-equivalence (^open "/@.")) (All [a] (-> (Equivalence a) (Equivalence (Composite a)))) (def: (= reference sample) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index e34c78f71..890722aeb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -3,7 +3,8 @@ [abstract ["." monad (#+ do)]] [control - ["ex" exception (#+ exception:)]] + [pipe (#+ case>)] + ["." exception (#+ exception:)]] [data ["." maybe] ["." text @@ -22,10 +23,11 @@ ["." phase ("#@." monad)]]]]) (exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment}) - (ex.report ["Foreign" (%.nat foreign)] - ["Environment" (|> environment - (list@map ////reference/variable.format) - (text.join-with " "))])) + (exception.report + ["Foreign" (%.nat foreign)] + ["Environment" (|> environment + (list@map ////reference/variable.format) + (text.join-with " "))])) (def: arity-arguments (-> Arity (List Synthesis)) @@ -46,15 +48,15 @@ (let [[funcA argsA] (////analysis.application exprA)] (do {@ phase.monad} [funcS (phase archive funcA) - argsS (monad.map @ (phase archive) argsA) - ## locals /.locals - ] + argsS (monad.map @ (phase archive) argsA)] (with-expansions [<apply> (as-is (/.function/apply [funcS argsS]))] (case funcS - ## (^ (/.function/abstraction functionS)) - ## (wrap (|> functionS - ## (//loop.loop (get@ #/.environment functionS) locals argsS) - ## (maybe.default <apply>))) + (^ (/.function/abstraction functionS)) + (do @ + [locals /.locals] + (wrap (|> functionS + (//loop.optimization locals argsS) + (maybe.default <apply>)))) (^ (/.function/apply [funcS' argsS'])) (wrap (/.function/apply [funcS' (list@compose argsS' argsS)])) @@ -69,7 +71,7 @@ (phase@wrap aliased) #.None - (phase.throw cannot-find-foreign-variable-in-environment [register environment]))) + (phase.throw ..cannot-find-foreign-variable-in-environment [register environment]))) (def: (grow-path grow path) (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) @@ -172,7 +174,7 @@ (do {@ phase.monad} [initsS+' (monad.map @ (grow environment) initsS+) iterationS' (grow environment iterationS)] - (wrap (/.loop/scope [start initsS+' iterationS']))) + (wrap (/.loop/scope [(inc start) initsS+' iterationS']))) (#/.Recur argumentsS+) (|> argumentsS+ @@ -209,7 +211,8 @@ (def: #export (abstraction phase environment archive bodyA) (-> Phase Environment Phase) (do {@ phase.monad} - [bodyS (phase archive bodyA)] + [bodyS (/.with-locals 2 + (phase archive bodyA))] (case bodyS (^ (/.function/abstraction [env' down-arity' bodyS'])) (|> bodyS' diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 5aa644e18..b4a43ce23 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -1,303 +1,171 @@ (.module: - [lux (#- loop) + [lux #* [abstract ["." monad (#+ do)]] - [control - ["p" parser]] [data ["." maybe ("#@." monad)] [number ["n" nat]] [collection - ["." list ("#@." functor)]]] - [macro - ["." code] - ["." syntax]]] - ["." /// #_ - ## TODO: Remove the 'extension' import ASAP. - ["#." extension] - [// - ["#." analysis (#+ Environment)] - ["/" synthesis (#+ Path Abstraction Synthesis)] - [/// - ["#." reference - ["#/." variable (#+ Register Variable)]]]]]) + ["." list]]]] + [//// + ["." analysis (#+ Environment)] + ["/" synthesis (#+ Path Abstraction Synthesis)] + [/// + [arity (#+ Arity)] + ["." reference + ["." variable (#+ Register Variable)]]]]) (type: #export (Transform a) (-> a (Maybe a))) -(def: (some? maybe) - (All [a] (-> (Maybe a) Bit)) - (case maybe - (#.Some _) #1 - #.None #0)) +(def: #export (register-optimization offset) + (-> Register (-> Register Register)) + (|>> dec (n.+ offset))) -(template: #export (self) - (#/.Reference (///reference.local 0))) +(def: (variable-optimization offset environment variable) + (-> Register Environment (Transform Variable)) + (case variable + (^ (variable.self)) + #.None + + (#variable.Foreign register) + (list.nth register environment) -(template: (recursive-apply args) - (#/.Apply (self) args)) + (#variable.Local register) + (#.Some (#variable.Local (register-optimization offset register))))) -(def: improper #0) -(def: proper #1) - -(def: (proper? exprS) - (-> Synthesis Bit) - (case exprS - (^ (self)) - ..improper - - (#/.Structure structure) - (case structure - (#///analysis.Variant variantS) - (proper? (get@ #///analysis.value variantS)) - - (#///analysis.Tuple membersS+) - (list.every? proper? membersS+)) - - (#/.Control controlS) - (case controlS - (#/.Branch branchS) - (case branchS - (#/.Case inputS pathS) - (and (proper? inputS) - (.loop [pathS pathS] - (case pathS - (^or (#/.Alt leftS rightS) (#/.Seq leftS rightS)) - (and (recur leftS) (recur rightS)) - - (#/.Then bodyS) - (proper? bodyS) - - _ - ..proper))) - - (#/.Let inputS register bodyS) - (and (proper? inputS) - (proper? bodyS)) - - (#/.If inputS thenS elseS) - (and (proper? inputS) - (proper? thenS) - (proper? elseS)) - - (#/.Get members inputS) - (proper? inputS)) - - (#/.Loop loopS) - (case loopS - (#/.Scope scopeS) - (and (list.every? proper? (get@ #/.inits scopeS)) - (proper? (get@ #/.iteration scopeS))) - - (#/.Recur argsS) - (list.every? proper? argsS)) - - (#/.Function functionS) - (case functionS - (#/.Abstraction environment arity bodyS) - (list.every? ///reference/variable.self? environment) - - (#/.Apply funcS argsS) - (and (proper? funcS) - (list.every? proper? argsS)))) - - (#/.Extension [name argsS]) - (list.every? proper? argsS) - - _ - ..proper)) - -(def: (path-recursion synthesis-recursion) - (-> (Transform Synthesis) (Transform Path)) - (function (recur pathS) - (case pathS - (#/.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'))) - #.None)) - - (#/.Seq leftS rightS) - (maybe@map (|>> (#/.Seq leftS)) (recur rightS)) - - (#/.Then bodyS) - (maybe@map (|>> #/.Then) (synthesis-recursion bodyS)) - - _ - #.None))) - -(def: #export (recursion arity) - (-> Nat (Transform Synthesis)) - (function (recur exprS) - (case exprS - (#/.Control controlS) - (case controlS - (#/.Branch branchS) - (case branchS - (#/.Case inputS pathS) - (|> pathS - (path-recursion recur) - (maybe@map (|>> (#/.Case inputS) #/.Branch #/.Control))) - - (#/.Let inputS register bodyS) - (maybe@map (|>> (#/.Let inputS register) #/.Branch #/.Control) - (recur bodyS)) - - (#/.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)) - #.None)) - - (#/.Get members inputS) - #.None) - - (^ (#/.Function (recursive-apply argsS))) - (if (n.= arity (list.size argsS)) - (#.Some (|> argsS #/.Recur #/.Loop #/.Control)) - #.None) - - _ - #.None) - - _ - #.None))) - -(def: (resolve environment) - (-> Environment (Transform Variable)) - (function (_ variable) - (case variable - (#///reference/variable.Foreign register) - (list.nth register environment) - - _ - (#.Some variable)))) - -(def: (adjust-path adjust-synthesis offset) +(def: (path-optimization body-optimization offset) (-> (Transform Synthesis) Register (Transform Path)) - (function (recur pathS) - (case pathS + (function (recur path) + (case path (#/.Bind register) - (#.Some (#/.Bind (n.+ offset register))) + (#.Some (#/.Bind (register-optimization offset register))) (^template [<tag>] - (<tag> leftS rightS) + (<tag> left right) (do maybe.monad - [leftS' (recur leftS) - rightS' (recur rightS)] - (wrap (<tag> leftS' rightS')))) + [left' (recur left) + right' (recur right)] + (wrap (<tag> left' right')))) ([#/.Alt] [#/.Seq]) - (#/.Then bodyS) - (|> bodyS adjust-synthesis (maybe@map (|>> #/.Then))) + (#/.Then body) + (|> body + body-optimization + (maybe@map (|>> #/.Then))) _ - (#.Some pathS)))) - -(def: (adjust scope-environment offset) - (-> Environment Register (Transform Synthesis)) - (function (recur exprS) - (case exprS - (#/.Structure structureS) - (case structureS - (#///analysis.Variant variantS) + (#.Some path)))) + +(def: (body-optimization offset scope-environment arity expr) + (-> Register Environment Arity (Transform Synthesis)) + (loop [return? true + expr expr] + (case expr + (#/.Primitive _) + (#.Some expr) + + (#/.Structure structure) + (case structure + (#analysis.Variant variant) (do maybe.monad - [valueS' (|> variantS (get@ #///analysis.value) recur)] - (wrap (|> variantS - (set@ #///analysis.value valueS') - #///analysis.Variant - #/.Structure))) + [value' (|> variant (get@ #analysis.value) (recur false))] + (wrap (|> variant + (set@ #analysis.value value') + /.variant))) - (#///analysis.Tuple membersS+) - (|> membersS+ - (monad.map maybe.monad recur) - (maybe@map (|>> #///analysis.Tuple #/.Structure)))) + (#analysis.Tuple tuple) + (|> tuple + (monad.map maybe.monad (recur false)) + (maybe@map (|>> /.tuple)))) (#/.Reference reference) (case reference - (^ (///reference.constant constant)) - (#.Some exprS) + (^ (#reference.Variable (variable.self))) + #.None + + (^ (reference.constant constant)) + (#.Some expr) - (^ (///reference.local register)) - (#.Some (#/.Reference (///reference.local (n.+ offset register)))) + (^ (reference.local register)) + (#.Some (#/.Reference (reference.local (register-optimization offset register)))) - (^ (///reference.foreign 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 [input path])) (do maybe.monad - [inputS' (recur inputS) - pathS' (adjust-path recur offset pathS)] - (wrap (|> pathS' [inputS'] /.branch/case))) + [input' (recur false input) + path' (path-optimization (recur return?) offset path)] + (wrap (|> path' [input'] /.branch/case))) - (^ (/.branch/let [inputS register bodyS])) + (^ (/.branch/let [input register body])) (do maybe.monad - [inputS' (recur inputS) - bodyS' (recur bodyS)] - (wrap (/.branch/let [inputS' register bodyS']))) + [input' (recur false input) + body' (recur return? body)] + (wrap (/.branch/let [input' (register-optimization offset register) body']))) - (^ (/.branch/if [inputS thenS elseS])) + (^ (/.branch/if [input then else])) (do maybe.monad - [inputS' (recur inputS) - thenS' (recur thenS) - elseS' (recur elseS)] - (wrap (/.branch/if [inputS' thenS' elseS']))) + [input' (recur false input) + then' (recur return? then) + else' (recur return? else)] + (wrap (/.branch/if [input' then' else']))) - (^ (/.loop/scope scopeS)) + (^ (/.branch/get [path record])) (do maybe.monad - [inits' (|> scopeS + [record (recur false record)] + (wrap (/.branch/get [path record]))) + + (^ (/.loop/scope scope)) + (do {@ maybe.monad} + [inits' (|> scope (get@ #/.inits) - (monad.map maybe.monad recur)) - iteration' (recur (get@ #/.iteration scopeS))] - (wrap (/.loop/scope {#/.start (|> scopeS (get@ #/.start) (n.+ offset)) + (monad.map @ (recur false))) + iteration' (recur return? (get@ #/.iteration scope))] + (wrap (/.loop/scope {#/.start (|> scope (get@ #/.start) (register-optimization offset)) #/.inits inits' #/.iteration iteration'}))) - (^ (/.loop/recur argsS)) - (|> argsS - (monad.map maybe.monad recur) + (^ (/.loop/recur args)) + (|> args + (monad.map maybe.monad (recur false)) (maybe@map (|>> /.loop/recur))) - - (^ (/.function/abstraction [environment arity bodyS])) - (do maybe.monad - [environment' (monad.map maybe.monad - (resolve scope-environment) + (^ (/.function/abstraction [environment arity body])) + (do {@ maybe.monad} + [environment' (monad.map @ (variable-optimization offset scope-environment) environment)] - (wrap (/.function/abstraction [environment' arity bodyS]))) + (wrap (/.function/abstraction [environment' arity body]))) - (^ (/.function/apply [function arguments])) - (do maybe.monad - [function' (recur function) - arguments' (monad.map maybe.monad recur arguments)] - (wrap (/.function/apply [function' arguments']))) - - (#/.Extension [name argsS]) - (|> argsS - (monad.map maybe.monad recur) - (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)] - (if (and (n.= (list.size inits) - (get@ #/.arity functionS)) - (proper? bodyS)) - (|> bodyS - (adjust environment num-locals) - (maybe@map (|>> [(inc num-locals) inits] /.loop/scope))) - #.None))) + (^ (/.function/apply [abstraction arguments])) + (do {! maybe.monad} + [arguments' (monad.map maybe.monad (recur false) arguments)] + (case abstraction + (^ (#/.Reference (#reference.Variable (variable.self)))) + (if (and return? + (n.= arity (list.size arguments))) + (wrap (/.loop/recur arguments')) + #.None) + + _ + (do ! + [abstraction' (recur false abstraction)] + (wrap (/.function/apply [abstraction' arguments']))))) + + (#/.Extension [name args]) + (|> args + (monad.map maybe.monad (recur false)) + (maybe@map (|>> [name] #/.Extension)))))) + +(def: #export (optimization offset inits functionS) + (-> Register (List Synthesis) Abstraction (Maybe Synthesis)) + (if (n.= (get@ #/.arity functionS) + (list.size inits)) + (|> (get@ #/.body functionS) + (body-optimization offset (get@ #/.environment functionS) (get@ #/.arity functionS)) + (maybe@map (|>> [offset inits] /.loop/scope))) + #.None)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux index a88d986fc..06f84d90d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux @@ -4,8 +4,9 @@ [monad (#+ do)] [equivalence (#+ Equivalence)]] [control - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data + ["." sum] ["." bit ("#@." equivalence)] ["." text ("#@." equivalence) ["%" format (#+ Format format)]] @@ -16,15 +17,15 @@ [collection ["." list ("#@." functor)] ["." dictionary (#+ Dictionary)]]]] - ["." // #_ - ["#." analysis (#+ Environment Composite Analysis)] + [// + ["." analysis (#+ Environment Composite Analysis)] [phase ["." extension (#+ Extension)]] [/// [arity (#+ Arity)] - ["#." reference (#+ Reference) - ["#/." variable (#+ Register Variable)]] - ["#." phase]]]) + ["." phase] + ["." reference (#+ Reference) + ["." variable (#+ Register Variable)]]]]) (type: #export Resolver (Dictionary Variable Variable)) @@ -33,7 +34,7 @@ (def: #export fresh-resolver Resolver - (dictionary.new //reference/variable.hash)) + (dictionary.new variable.hash)) (def: #export init State @@ -202,7 +203,7 @@ (def: #export with-new-local (All [a] (-> (Operation a) (Operation a))) - (<<| (do //phase.monad + (<<| (do phase.monad [locals ..locals]) (..with-locals (inc locals)))) @@ -222,8 +223,8 @@ <tag> content))] - [variant #//analysis.Variant] - [tuple #//analysis.Tuple] + [variant #analysis.Variant] + [tuple #analysis.Tuple] ) (template [<name> <tag>] @@ -232,10 +233,10 @@ <tag> content))] - [variable //reference.variable] - [constant //reference.constant] - [variable/local //reference.local] - [variable/foreign //reference.foreign] + [variable reference.variable] + [constant reference.constant] + [variable/local reference.local] + [variable/foreign reference.foreign] ) (template [<name> <family> <tag>] @@ -327,36 +328,35 @@ (#Structure structure) (case structure - (#//analysis.Variant [lefts right? content]) + (#analysis.Variant [lefts right? content]) (|> (%synthesis content) (format (%.nat lefts) " " (%.bit right?) " ") (text.enclose ["(" ")"])) - (#//analysis.Tuple members) + (#analysis.Tuple members) (|> members (list@map %synthesis) (text.join-with " ") (text.enclose ["[" "]"]))) (#Reference reference) - (//reference.format reference) + (reference.format reference) (#Control control) (case control (#Function function) (case function (#Abstraction [environment arity body]) - (|> (%synthesis body) - (format (%.nat arity) " ") - (format (|> environment - (list@map //reference/variable.format) - (text.join-with " ") - (text.enclose ["[" "]"])) - " ") - (text.enclose ["(" ")"])) + (let [environment' (|> environment + (list@map variable.format) + (text.join-with " ") + (text.enclose ["[" "]"]))] + (|> (format environment' " " (%.nat arity) " " (%synthesis body)) + (text.enclose ["(#function " ")"]))) (#Apply func args) - (|> (list@map %synthesis args) + (|> args + (list@map %synthesis) (text.join-with " ") (format (%synthesis func) " ") (text.enclose ["(" ")"]))) @@ -364,7 +364,7 @@ (#Branch branch) (case branch (#Let input register body) - (|> (format (%synthesis input) " " (%.nat register) " " (%synthesis body)) + (|> (format (%.nat register) " " (%synthesis input) " " (%synthesis body)) (text.enclose ["(#let " ")"])) (#If test then else) @@ -381,9 +381,22 @@ (|> (format (%synthesis input) " " (%path' %synthesis path)) (text.enclose ["(#case " ")"]))) - ## (#Loop loop) - _ - "???") + (#Loop loop) + (case loop + (#Scope scope) + (|> (format (%.nat (get@ #start scope)) + " " (|> (get@ #inits scope) + (list@map %synthesis) + (text.join-with " ") + (text.enclose ["[" "]"])) + " " (%synthesis (get@ #iteration scope))) + (text.enclose ["(#loop " ")"])) + + (#Recur args) + (|> args + (list@map %synthesis) + (text.join-with " ") + (text.enclose ["(#recur " ")"])))) (#Extension [name args]) (|> (list@map %synthesis args) @@ -395,7 +408,9 @@ (Format Path) (%path' %synthesis)) -(structure: #export primitive-equivalence (Equivalence Primitive) +(structure: #export primitive-equivalence + (Equivalence Primitive) + (def: (= reference sample) (case [reference sample] (^template [<tag> <eq> <format>] @@ -411,27 +426,29 @@ _ false))) -(structure: #export access-equivalence (Equivalence Access) +(def: side-equivalence + (Equivalence Side) + (sum.equivalence n.equivalence n.equivalence)) + +(def: member-equivalence + (Equivalence Member) + (sum.equivalence n.equivalence n.equivalence)) + +(structure: #export access-equivalence + (Equivalence Access) + (def: (= reference sample) (case [reference sample] - (^template [<tag>] - [(<tag> reference') (<tag> sample')] - (case [reference' sample'] - (^template [<side>] - [(<side> reference'') (<side> sample'')] - (n.= reference'' sample'')) - ([#.Left] - [#.Right]) - - _ - false)) - ([#Side] - [#Member]) + (^template [<tag> <equivalence>] + [(<tag> reference) (<tag> sample)] + (:: <equivalence> = reference sample)) + ([#Side ..side-equivalence] + [#Member ..member-equivalence]) _ false))) -(structure: #export (path'-equivalence Equivalence<a>) +(structure: #export (path'-equivalence equivalence) (All [a] (-> (Equivalence a) (Equivalence (Path' a)))) (def: (= reference sample) @@ -444,7 +461,7 @@ (:: <equivalence> = reference' sample')) ([#Test primitive-equivalence] [#Access access-equivalence] - [#Then Equivalence<a>]) + [#Then equivalence]) [(#Bind reference') (#Bind sample')] (n.= reference' sample') @@ -459,13 +476,100 @@ _ false))) -(structure: #export equivalence (Equivalence Synthesis) +(structure: (branch-equivalence (^open "/@.")) + (All [a] (-> (Equivalence a) (Equivalence (Branch a)))) + + (def: (= reference sample) + (case [reference sample] + [(#Let [reference-input reference-register reference-body]) + (#Let [sample-input sample-register sample-body])] + (and (/@= reference-input sample-input) + (n.= reference-register sample-register) + (/@= reference-body sample-body)) + + [(#If [reference-test reference-then reference-else]) + (#If [sample-test sample-then sample-else])] + (and (/@= reference-test sample-test) + (/@= reference-then sample-then) + (/@= reference-else sample-else)) + + [(#Get [reference-path reference-record]) + (#Get [sample-path sample-record])] + (and (:: (list.equivalence ..member-equivalence) = reference-path sample-path) + (/@= reference-record sample-record)) + + [(#Case [reference-input reference-path]) + (#Case [sample-input sample-path])] + (and (/@= reference-input sample-input) + (:: (path'-equivalence /@=) = reference-path sample-path)) + + _ + false))) + +(structure: (loop-equivalence (^open "/@.")) + (All [a] (-> (Equivalence a) (Equivalence (Loop a)))) + + (def: (= reference sample) + (case [reference sample] + [(#Scope [reference-start reference-inits reference-iteration]) + (#Scope [sample-start sample-inits sample-iteration])] + (and (n.= reference-start sample-start) + (:: (list.equivalence /@=) = reference-inits sample-inits) + (/@= reference-iteration sample-iteration)) + + [(#Recur reference) (#Recur sample)] + (:: (list.equivalence /@=) = reference sample) + + _ + false))) + +(structure: (function-equivalence (^open "/@.")) + (All [a] (-> (Equivalence a) (Equivalence (Function a)))) + + (def: (= reference sample) + (case [reference sample] + [(#Abstraction [reference-environment reference-arity reference-body]) + (#Abstraction [sample-environment sample-arity sample-body])] + (and (:: (list.equivalence variable.equivalence) = reference-environment sample-environment) + (n.= reference-arity sample-arity) + (/@= reference-body sample-body)) + + [(#Apply [reference-abstraction reference-arguments]) + (#Apply [sample-abstraction sample-arguments])] + (and (/@= reference-abstraction sample-abstraction) + (:: (list.equivalence /@=) = reference-arguments sample-arguments)) + + _ + false))) + +(structure: (control-equivalence (^open "/@.")) + (All [a] (-> (Equivalence a) (Equivalence (Control a)))) + + (def: (= reference sample) + (case [reference sample] + (^template [<tag> <equivalence>] + [(<tag> reference) (<tag> sample)] + (:: (<equivalence> /@=) = reference sample)) + ([#Branch ..branch-equivalence] + [#Loop ..loop-equivalence] + [#Function ..function-equivalence]) + + _ + false))) + +(structure: #export equivalence + (Equivalence Synthesis) + (def: (= reference sample) (case [reference sample] (^template [<tag> <equivalence>] [(<tag> reference') (<tag> sample')] (:: <equivalence> = reference' sample')) - ([#Primitive primitive-equivalence]) + ([#Primitive ..primitive-equivalence] + [#Structure (analysis.composite-equivalence =)] + [#Reference reference.equivalence] + [#Control (control-equivalence =)] + [#Extension (extension.equivalence =)]) _ false))) diff --git a/stdlib/source/lux/tool/compiler/reference/variable.lux b/stdlib/source/lux/tool/compiler/reference/variable.lux index 10c080c6e..e0c814e8d 100644 --- a/stdlib/source/lux/tool/compiler/reference/variable.lux +++ b/stdlib/source/lux/tool/compiler/reference/variable.lux @@ -42,9 +42,12 @@ (#Foreign register) (|> register .int (i.* -1) .nat))))) +(template: #export (self) + (#..Local 0)) + (def: #export self? (-> Variable Bit) - (|>> (case> (^ (#Local 0)) + (|>> (case> (^ (..self)) true _ |