aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-03-03 12:09:56 -0400
committerEduardo Julian2019-03-03 12:09:56 -0400
commitf4bb7ff1455659a766a074506b54129e0037db64 (patch)
treebbf79c07fa08088c99aca93236ce1eaa0974d333
parent539ad81bbb9034e41e6ca8f5445a9dd239c60be1 (diff)
Some refactoring around synthesis.
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/default/evaluation.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/statement.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/statement.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/synthesis.lux542
-rw-r--r--stdlib/source/lux/tool/compiler/phase/synthesis/case.lux91
-rw-r--r--stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux89
-rw-r--r--stdlib/source/lux/tool/compiler/phase/synthesis/function.lux101
-rw-r--r--stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux157
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation.lux35
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/common/reference.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/case.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/expression.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/extension/common.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/extension/host.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/function.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/runtime.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/synthesis.lux468
28 files changed, 787 insertions, 776 deletions
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 [<special> <general>]
- [(type: #export <special>
- (<general> ..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 [<name> <tag>]
- [(template: #export (<name> content)
- (#..Test (<tag> content)))]
-
- [path/bit #..Bit]
- [path/i64 #..I64]
- [path/f64 #..F64]
- [path/text #..Text]
- )
-
-(do-template [<name> <kind>]
- [(template: #export (<name> content)
- (.<| #..Access
- <kind>
- content))]
-
- [path/side #..Side]
- [path/member #..Member]
- )
-
-(do-template [<name> <kind> <side>]
- [(template: #export (<name> content)
- (.<| #..Access
- <kind>
- <side>
- content))]
-
- [side/left #..Side #.Left]
- [side/right #..Side #.Right]
- [member/left #..Member #.Left]
- [member/right #..Member #.Right]
- )
-
-(do-template [<name> <tag>]
- [(template: #export (<name> content)
- (<tag> content))]
-
- [path/bind #..Bind]
- [path/then #..Then]
- )
-
-(do-template [<name> <tag>]
- [(template: #export (<name> left right)
- (<tag> [left right]))]
-
- [path/alt #..Alt]
- [path/seq #..Seq]
- )
-
-(type: #export Abstraction
- (Abstraction' Synthesis))
-
-(type: #export Apply
- (Apply' Synthesis))
-
-(def: #export unit Text "")
-
-(do-template [<name> <type> <tag>]
- [(def: #export (<name> value)
- (-> <type> (All [a] (-> (Operation a) (Operation a))))
- (extension.temporary (set@ <tag> 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 [<name> <tag> <type>]
- [(def: #export <name>
- (Operation <type>)
- (extension.read (get@ <tag>)))]
-
- [locals #locals Nat]
- )
-
-(def: #export with-new-local
- (All [a] (-> (Operation a) (Operation a)))
- (<<| (do //.monad
- [locals ..locals])
- (..with-locals (inc locals))))
-
-(do-template [<name> <tag>]
- [(template: #export (<name> content)
- (#..Primitive (<tag> content)))]
-
- [bit #..Bit]
- [i64 #..I64]
- [f64 #..F64]
- [text #..Text]
- )
-
-(do-template [<name> <tag>]
- [(template: #export (<name> content)
- (<| #..Structure
- <tag>
- content))]
-
- [variant #analysis.Variant]
- [tuple #analysis.Tuple]
- )
-
-(do-template [<name> <tag>]
- [(template: #export (<name> content)
- (.<| #..Reference
- <tag>
- content))]
-
- [variable/local reference.local]
- [variable/foreign reference.foreign]
- )
-
-(do-template [<name> <tag>]
- [(template: #export (<name> content)
- (.<| #..Reference
- <tag>
- content))]
-
- [variable reference.variable]
- [constant reference.constant]
- )
-
-(do-template [<name> <family> <tag>]
- [(template: #export (<name> content)
- (.<| #..Control
- <family>
- <tag>
- 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 [<pattern> <format>]
- (<pattern> value)
- (<format> value))
- ([#Bit %b]
- [#F64 %f]
- [#Text %t])
-
- (#I64 value)
- (%i (.int value)))
-
- (#Structure structure)
+ (^template [<analysis> <synthesis>]
+ (<analysis> value)
+ (<synthesis> value))
+ ([#analysis.Bit #/.Bit]
+ [#analysis.Frac #/.F64]
+ [#analysis.Text #/.Text])
+
+ (^template [<analysis> <synthesis>]
+ (<analysis> value)
+ (<synthesis> (.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 [<tag> <eq> <format>]
- [(<tag> reference') (<tag> sample')]
- (<eq> 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 [<tag>]
- [(<tag> reference') (<tag> sample')]
- (case [reference' sample']
- (^template [<side>]
- [(<side> reference'') (<side> sample'')]
- (n/= reference'' sample''))
- ([#.Left]
- [#.Right])
-
- _
- false))
- ([#Side]
- [#Member])
-
- _
- false)))
-
-(structure: #export (path'-equivalence Equivalence<a>)
- (All [a] (-> (Equivalence a) (Equivalence (Path' a))))
-
- (def: (= reference sample)
- (case [reference sample]
- [#Pop #Pop]
- true
-
- (^template [<tag> <equivalence>]
- [(<tag> reference') (<tag> sample')]
- (:: <equivalence> = reference' sample'))
- ([#Test primitive-equivalence]
- [#Access access-equivalence]
- [#Then Equivalence<a>])
-
- [(#Bind reference') (#Bind sample')]
- (n/= reference' sample')
-
- (^template [<tag>]
- [(<tag> leftR rightR) (<tag> leftS rightS)]
- (and (= leftR leftS)
- (= rightR rightS)))
- ([#Alt]
- [#Seq])
-
- _
- 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])
-
- _
- 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 [<from> <to>]
(<from> value)
- (////map (|>> (#//.Seq (#//.Test (|> value <to>))))
+ (////map (|>> (#/.Seq (#/.Test (|> value <to>))))
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 [<default> (as-is (#//.Alt leftP rightP))]
+ (with-expansions [<default> (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 _)
<default>
weavedP
- (#//.Seq weavedP (weave postL postR)))
+ (#/.Seq weavedP (weave postL postR)))
- [#//.Pop #//.Pop]
+ [#/.Pop #/.Pop]
rightP
(^template [<tag> <eq>]
- [(#//.Test (<tag> leftV))
- (#//.Test (<tag> rightV))]
+ [(#/.Test (<tag> leftV))
+ (#/.Test (<tag> rightV))]
(if (<eq> leftV rightV)
rightP
<default>))
- ([#//.Bit bit/=]
- [#//.I64 "lux i64 ="]
- [#//.F64 frac/=]
- [#//.Text text/=])
+ ([#/.Bit bit/=]
+ [#/.I64 "lux i64 ="]
+ [#/.F64 frac/=]
+ [#/.Text text/=])
(^template [<access> <side>]
- [(#//.Access (<access> (<side> leftL)))
- (#//.Access (<access> (<side> rightL)))]
+ [(#/.Access (<access> (<side> leftL)))
+ (#/.Access (<access> (<side> rightL)))]
(if (n/= leftL rightL)
rightP
<default>))
- ([#//.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
<default>)
@@ -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])))))
<if>
(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]))))
<case>
(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+]
<let>
<if>
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 [<analysis> <synthesis>]
- (<analysis> value)
- (<synthesis> value))
- ([#analysis.Bit #//.Bit]
- [#analysis.Frac #//.F64]
- [#analysis.Text #//.Text])
-
- (^template [<analysis> <synthesis>]
- (<analysis> value)
- (<synthesis> (.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 [<apply> (as-is (//.function/apply [funcS argsS]))]
+ (with-expansions [<apply> (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 <apply>)))
- (^ (//.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 <apply>)))))))
@@ -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 [<tag>]
(<tag> left right)
@@ -79,12 +80,12 @@
[left' (grow-path grow left)
right' (grow-path grow right)]
(wrap (<tag> 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 [<tag>]
(<tag> leftS rightS)
@@ -183,10 +184,10 @@
[leftS' (recur leftS)
rightS' (recur rightS)]
(wrap (<tag> 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 [<name>]
[(exception: #export (<name>)
@@ -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 [<name>]
[(exception: #export (<name> {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> []))))]
+ (exception.throw <exception> []))))]
[#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 [<name> <js>]
[(def: (<name> _) Nullary <js>)]
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 [<name> <base>]
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 [<special> <general>]
+ [(type: #export <special>
+ (<general> ..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 [<name> <tag>]
+ [(template: #export (<name> content)
+ (#..Test (<tag> content)))]
+
+ [path/bit #..Bit]
+ [path/i64 #..I64]
+ [path/f64 #..F64]
+ [path/text #..Text]
+ )
+
+(do-template [<name> <kind>]
+ [(template: #export (<name> content)
+ (.<| #..Access
+ <kind>
+ content))]
+
+ [path/side #..Side]
+ [path/member #..Member]
+ )
+
+(do-template [<name> <kind> <side>]
+ [(template: #export (<name> content)
+ (.<| #..Access
+ <kind>
+ <side>
+ content))]
+
+ [side/left #..Side #.Left]
+ [side/right #..Side #.Right]
+ [member/left #..Member #.Left]
+ [member/right #..Member #.Right]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (<tag> content))]
+
+ [path/bind #..Bind]
+ [path/then #..Then]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> left right)
+ (<tag> [left right]))]
+
+ [path/alt #..Alt]
+ [path/seq #..Seq]
+ )
+
+(type: #export Abstraction
+ (Abstraction' Synthesis))
+
+(type: #export Apply
+ (Apply' Synthesis))
+
+(def: #export unit Text "")
+
+(do-template [<name> <type> <tag>]
+ [(def: #export (<name> value)
+ (-> <type> (All [a] (-> (Operation a) (Operation a))))
+ (extension.temporary (set@ <tag> 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 [<name> <tag> <type>]
+ [(def: #export <name>
+ (Operation <type>)
+ (extension.read (get@ <tag>)))]
+
+ [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 [<name> <tag>]
+ [(template: #export (<name> content)
+ (#..Primitive (<tag> content)))]
+
+ [bit #..Bit]
+ [i64 #..I64]
+ [f64 #..F64]
+ [text #..Text]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (<| #..Structure
+ <tag>
+ content))]
+
+ [variant #//analysis.Variant]
+ [tuple #//analysis.Tuple]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (.<| #..Reference
+ <tag>
+ content))]
+
+ [variable/local //reference.local]
+ [variable/foreign //reference.foreign]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (.<| #..Reference
+ <tag>
+ content))]
+
+ [variable //reference.variable]
+ [constant //reference.constant]
+ )
+
+(do-template [<name> <family> <tag>]
+ [(template: #export (<name> content)
+ (.<| #..Control
+ <family>
+ <tag>
+ 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 [<pattern> <format>]
+ (<pattern> value)
+ (<format> 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 [<tag> <eq> <format>]
+ [(<tag> reference') (<tag> sample')]
+ (<eq> 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 [<tag>]
+ [(<tag> reference') (<tag> sample')]
+ (case [reference' sample']
+ (^template [<side>]
+ [(<side> reference'') (<side> sample'')]
+ (n/= reference'' sample''))
+ ([#.Left]
+ [#.Right])
+
+ _
+ false))
+ ([#Side]
+ [#Member])
+
+ _
+ false)))
+
+(structure: #export (path'-equivalence Equivalence<a>)
+ (All [a] (-> (Equivalence a) (Equivalence (Path' a))))
+
+ (def: (= reference sample)
+ (case [reference sample]
+ [#Pop #Pop]
+ true
+
+ (^template [<tag> <equivalence>]
+ [(<tag> reference') (<tag> sample')]
+ (:: <equivalence> = reference' sample'))
+ ([#Test primitive-equivalence]
+ [#Access access-equivalence]
+ [#Then Equivalence<a>])
+
+ [(#Bind reference') (#Bind sample')]
+ (n/= reference' sample')
+
+ (^template [<tag>]
+ [(<tag> leftR rightR) (<tag> leftS rightS)]
+ (and (= leftR leftS)
+ (= rightR rightS)))
+ ([#Alt]
+ [#Seq])
+
+ _
+ 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])
+
+ _
+ false)))
+
+(def: #export path-equivalence
+ (Equivalence Path)
+ (path'-equivalence equivalence))