From 015134cd44e066e49b3bac56b442a6150c782600 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 2 Aug 2018 23:03:19 -0400
Subject: Moved statement phase into stdlib.
---
stdlib/source/lux.lux | 16 +-
stdlib/source/lux/compiler/default/phase.lux | 16 ++
.../source/lux/compiler/default/phase/analysis.lux | 24 ++-
.../lux/compiler/default/phase/analysis/module.lux | 2 +-
.../compiler/default/phase/analysis/structure.lux | 3 +-
.../compiler/default/phase/extension/bundle.lux | 10 +-
.../compiler/default/phase/extension/statement.lux | 184 +++++++++++++++++++++
.../compiler/default/phase/extension/synthesis.lux | 16 +-
.../default/phase/extension/translation.lux | 16 +-
.../lux/compiler/default/phase/statement.lux | 55 ++++++
.../lux/compiler/default/phase/synthesis.lux | 18 +-
.../lux/compiler/default/phase/translation.lux | 24 ++-
stdlib/test/tests.lux | 13 +-
13 files changed, 330 insertions(+), 67 deletions(-)
create mode 100644 stdlib/source/lux/compiler/default/phase/extension/statement.lux
create mode 100644 stdlib/source/lux/compiler/default/phase/statement.lux
(limited to 'stdlib')
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 34ceb43ba..1c7969f99 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5832,10 +5832,16 @@
(fail "Wrong syntax for undefined")))
(macro: #export (:of tokens)
- {#.doc (doc "Generates the type corresponding to a given definition or variable."
- (let [my-num (: Int +123)]
+ {#.doc (doc "Generates the type corresponding to a given expression."
+ "Example #1:"
+ (let [my-num +123]
(:of my-num))
"=="
+ Int
+ "-------------------"
+ "Example #2:"
+ (:of +123)
+ "=="
Int)}
(case tokens
(^ (list [_ (#Identifier var-name)]))
@@ -5843,6 +5849,12 @@
[var-type (find-type var-name)]
(wrap (list (type-to-code var-type))))
+ (^ (list expression))
+ (do Monad
+ [g!temp (gensym "g!temp")]
+ (wrap (list (` (let [(~ g!temp) (~ expression)]
+ (..:of (~ g!temp)))))))
+
_
(fail "Wrong syntax for :of")))
diff --git a/stdlib/source/lux/compiler/default/phase.lux b/stdlib/source/lux/compiler/default/phase.lux
index ae146be74..85567e45c 100644
--- a/stdlib/source/lux/compiler/default/phase.lux
+++ b/stdlib/source/lux/compiler/default/phase.lux
@@ -33,6 +33,22 @@
operation
(:: error.Monad map product.right)))
+(def: #export state
+ (All [s o]
+ (Operation s s))
+ (function (_ state)
+ (#error.Success [state state])))
+
+(def: #export (sub [get set] operation)
+ (All [s s' o]
+ (-> [(-> s s') (-> s' s s)]
+ (Operation s' o)
+ (Operation s o)))
+ (function (_ state)
+ (do error.Monad
+ [[state' output] (operation (get state))]
+ (wrap [(set state' state) output]))))
+
(def: #export fail
(-> Text Operation)
(|>> error.fail (state.lift error.Monad)))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 72d2a3485..ccf46b873 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -51,20 +51,16 @@
(#Apply Analysis Analysis)
(#Extension (Extension Analysis)))
-(type: #export State+
- (extension.State .Lux Code Analysis))
-
-(type: #export Operation
- (extension.Operation .Lux Code Analysis))
-
-(type: #export Phase
- (extension.Phase .Lux Code Analysis))
-
-(type: #export Handler
- (extension.Handler .Lux .Code Analysis))
-
-(type: #export Bundle
- (extension.Bundle .Lux .Code Analysis))
+(do-template [ ]
+ [(type: #export
+ ( .Lux Code Analysis))]
+
+ [State+ extension.State]
+ [Operation extension.Operation]
+ [Phase extension.Phase]
+ [Handler extension.Handler]
+ [Bundle extension.Bundle]
+ )
(type: #export Branch
(Branch' Analysis))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
index 61d3a2ec6..5812ef3d2 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/module.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
@@ -112,7 +112,7 @@
[state] #error.Success))))
(def: #export (define name definition)
- (-> Text Definition (Operation []))
+ (-> Text Definition (Operation Any))
(do ///.Monad
[self-name (extension.lift macro.current-module-name)
self (extension.lift macro.current-module)]
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
index f894679ef..2977eb777 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
@@ -22,8 +22,7 @@
["." primitive]
["." inference]
["/." //
- ["." extension]
- ["//." //]]])
+ ["." extension]]])
(exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code})
(ex.report ["Type" (%type type)]
diff --git a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux
index e2d36fa73..4fe68b23c 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux
@@ -8,7 +8,7 @@
format]
[collection
[list ("list/." Functor)]
- ["dict" dictionary (#+ Dictionary)]]]]
+ ["." dictionary (#+ Dictionary)]]]]
[// (#+ Handler Bundle)])
(exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat})
@@ -22,17 +22,17 @@
## [Utils]
(def: #export empty
Bundle
- (dict.new text.Hash))
+ (dictionary.new text.Hash))
(def: #export (install name anonymous)
(All [s i o]
(-> Text (Handler s i o)
(-> (Bundle s i o) (Bundle s i o))))
- (dict.put name anonymous))
+ (dictionary.put name anonymous))
(def: #export (prefix prefix)
(All [s i o]
(-> Text (-> (Bundle s i o) (Bundle s i o))))
- (|>> dict.entries
+ (|>> dictionary.entries
(list/map (function (_ [key val]) [(format prefix " " key) val]))
- (dict.from-list text.Hash)))
+ (dictionary.from-list text.Hash)))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
new file mode 100644
index 000000000..2c2bf4464
--- /dev/null
+++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
@@ -0,0 +1,184 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ [collection
+ [list ("list/." Functor)]
+ ["." dictionary]]]
+ ["." macro]
+ [type (#+ :share)
+ ["." check]]]
+ [//
+ ["/." // (#+ Eval)
+ ["." analysis
+ ["." module]
+ ["." type]]
+ ["." synthesis]
+ ["." translation]
+ ["." statement (#+ Operation Handler Bundle)]
+ ["." extension
+ ["." bundle]]
+ [//
+ ["." evaluation]]]])
+
+(do-template [ ]
+ [(def: ( operation)
+ (All [anchor expression statement output]
+ (-> ( output) (Operation anchor expression statement output)))
+ (extension.lift
+ (///.sub [(get@ [ #statement.state])
+ (set@ [ #statement.state])]
+ operation)))]
+
+ [lift-analysis! #statement.analysis analysis.Operation]
+ [lift-synthesis! #statement.synthesis synthesis.Operation]
+ [lift-translation! #statement.translation (translation.Operation anchor expression statement)]
+ )
+
+(def: (compile ?name ?type codeC)
+ (All [anchor expression statement]
+ (-> (Maybe Name) (Maybe Type) Code
+ (Operation anchor expression statement [Type expression Any])))
+ (do ///.Monad
+ [state (extension.lift ///.state)
+ #let [analyse (get@ [#statement.analysis #statement.phase] state)
+ synthesize (get@ [#statement.synthesis #statement.phase] state)
+ translate (get@ [#statement.translation #statement.phase] state)]
+ [_ code//type codeA] (lift-analysis!
+ (analysis.with-scope
+ (type.with-fresh-env
+ (case ?type
+ (#.Some type)
+ (type.with-type type
+ (do @
+ [codeA (analyse codeC)]
+ (wrap [type codeA])))
+
+ #.None
+ (do @
+ [[code//type codeA] (type.with-inference (analyse codeC))
+ code//type (type.with-env
+ (check.clean code//type))]
+ (wrap [code//type codeA]))))))
+ codeS (lift-synthesis!
+ (synthesize codeA))]
+ (lift-translation!
+ (do @
+ [codeT (translate codeS)
+ codeV (case ?name
+ (#.Some name)
+ (translation.define! name codeT)
+
+ #.None
+ (translation.evaluate! codeT))]
+ (wrap [code//type codeT codeV])))))
+
+(def: lux::def
+ Handler
+ (function (_ extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list [_ (#.Identifier ["" def-name])] valueC annotationsC))
+ (do ///.Monad
+ [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC)
+ #let [annotationsV (:coerce Code annotationsV)]
+ current-module (lift-analysis!
+ (extension.lift
+ macro.current-module-name))
+ [value//type valueT valueV] (compile (#.Some [current-module def-name])
+ (if (macro.type? annotationsV)
+ (#.Some Type)
+ #.None)
+ valueC)]
+ (lift-analysis!
+ (do @
+ [_ (module.define def-name [value//type annotationsV valueV])]
+ (if (macro.type? annotationsV)
+ (case (macro.declared-tags annotationsV)
+ #.Nil
+ (wrap [])
+
+ tags
+ (module.declare-tags tags (macro.export? annotationsV) (:coerce Type valueV)))
+ (wrap [])))))
+
+ _
+ (///.throw bundle.invalid-syntax [extension-name]))))
+
+(def: (alias! alias def-name)
+ (-> Text Name (analysis.Operation Any))
+ (do ///.Monad
+ [definition (extension.lift (macro.find-def def-name))]
+ (module.define alias definition)))
+
+(def: def::alias
+ Handler
+ (function (_ extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)]))
+ (extension.lift
+ (///.sub [(get@ [#statement.analysis #statement.state])
+ (set@ [#statement.analysis #statement.state])]
+ (alias! alias def-name)))
+
+ _
+ (///.throw bundle.invalid-syntax [extension-name]))))
+
+(do-template [ ]
+ [(def:
+ (All [anchor expression statement]
+ (Handler anchor expression statement))
+ (function (handler extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list [_ (#.Text name)] valueC))
+ (do ///.Monad
+ [[_ handlerT handlerV] (compile #.None
+ (#.Some (:of (:share [anchor expression statement]
+ {(Handler anchor expression statement)
+ handler}
+ {
+ (:assume [])})))
+ valueC)]
+ (<|
+ (extension.install name)
+ (:share [anchor expression statement]
+ {(Handler anchor expression statement)
+ handler}
+ {
+ (:assume handlerV)})))
+
+ _
+ (///.throw bundle.invalid-syntax [extension-name]))))]
+
+ [def::analysis analysis.Handler lift-analysis!]
+ [def::synthesis synthesis.Handler
+ (<| extension.lift
+ (///.sub [(get@ [#statement.synthesis #statement.state])
+ (set@ [#statement.synthesis #statement.state])]))]
+ [def::translation (translation.Handler anchor expression statement)
+ (<| extension.lift
+ (///.sub [(get@ [#statement.translation #statement.state])
+ (set@ [#statement.translation #statement.state])]))]
+
+ [def::statement (Handler anchor expression statement)
+ (<|)]
+ )
+
+(def: bundle::def
+ Bundle
+ (<| (bundle.prefix "def")
+ (|> bundle.empty
+ (dictionary.put "alias" def::alias)
+ (dictionary.put "analysis" def::analysis)
+ (dictionary.put "synthesis" def::synthesis)
+ (dictionary.put "translation" def::translation)
+ (dictionary.put "statement" def::statement)
+ )))
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "lux")
+ (|> bundle.empty
+ (dictionary.put "def" lux::def)
+ (dictionary.merge ..bundle::def))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux
index d907808a8..1a2e44f6f 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux
@@ -1,10 +1,10 @@
(.module:
- [lux #*
- [data
- [text]
- [collection ["dict" dictionary (#+ Dictionary)]]]]
- [//])
+ [lux #*]
+ [//
+ ["." bundle]
+ [//
+ [synthesis (#+ Bundle)]]])
-(def: #export defaults
- (Dictionary Text //.Synthesis)
- (dict.new text.Hash))
+(def: #export bundle
+ Bundle
+ bundle.empty)
diff --git a/stdlib/source/lux/compiler/default/phase/extension/translation.lux b/stdlib/source/lux/compiler/default/phase/extension/translation.lux
index 3a43e0dcb..232c8c168 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/translation.lux
@@ -1,10 +1,10 @@
(.module:
- [lux #*
- [data
- [text]
- [collection ["dict" dictionary (#+ Dictionary)]]]]
- [//])
+ [lux #*]
+ [//
+ ["." bundle]
+ [//
+ [translation (#+ Bundle)]]])
-(def: #export defaults
- (Dictionary Text //.Translation)
- (dict.new text.Hash))
+(def: #export bundle
+ Bundle
+ bundle.empty)
diff --git a/stdlib/source/lux/compiler/default/phase/statement.lux b/stdlib/source/lux/compiler/default/phase/statement.lux
new file mode 100644
index 000000000..638f29b80
--- /dev/null
+++ b/stdlib/source/lux/compiler/default/phase/statement.lux
@@ -0,0 +1,55 @@
+(.module:
+ [lux #*]
+ [// (#+ Eval)
+ ["." analysis
+ [".A" expression]]
+ ["." synthesis
+ [".S" expression]]
+ ["." translation (#+ Host)]
+ ["." extension
+ ["." bundle]
+ [".E" analysis]
+ [".E" synthesis]
+ [".E" translation]
+ ## [".E" statement]
+ ]
+ [//
+ ["." init]]])
+
+(type: #export (Component state phase)
+ {#state state
+ #phase phase})
+
+(type: #export (State anchor expression statement)
+ {#analysis (Component analysis.State+
+ analysis.Phase)
+ #synthesis (Component synthesis.State+
+ synthesis.Phase)
+ #translation (Component (translation.State+ anchor expression statement)
+ (translation.Phase anchor expression statement))})
+
+(do-template [ ]
+ [(type: #export ( anchor expression statement)
+ ( (..State anchor expression statement) Code Any))]
+
+ [State+ extension.State]
+ [Operation extension.Operation]
+ [Phase extension.Phase]
+ [Handler extension.Handler]
+ [Bundle extension.Bundle]
+ )
+
+(def: #export (state eval translate host)
+ (All [anchor expression statement]
+ (-> Eval
+ (translation.Phase anchor expression statement)
+ (Host expression statement)
+ (..State+ anchor expression statement)))
+ [bundle.empty
+ ## statementE.bundle
+ {#analysis {#state [analysisE.bundle (init.compiler [])]
+ #phase (expressionA.analyser eval)}
+ #synthesis {#state [synthesisE.bundle synthesis.init]
+ #phase expressionS.synthesize}
+ #translation {#state [translationE.bundle (translation.state host)]
+ #phase translate}}])
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux
index 2ee018be4..29c2189c3 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux
@@ -98,14 +98,16 @@
(#Control (Control Synthesis))
(#Extension (Extension Synthesis)))
-(type: #export State+
- (extension.State ..State Analysis Synthesis))
-
-(type: #export Operation
- (extension.Operation ..State Analysis Synthesis))
-
-(type: #export Phase
- (extension.Phase ..State Analysis 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))
diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux
index d8a58ca84..3bf09937f 100644
--- a/stdlib/source/lux/compiler/default/phase/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation.lux
@@ -73,20 +73,16 @@
#counter Nat
#name-cache (Dictionary Name Text)})
-(type: #export (State+ anchor expression statement)
- (extension.State (State anchor expression statement) Synthesis expression))
-
-(type: #export (Operation anchor expression statement)
- (extension.Operation (State anchor expression statement) Synthesis expression))
-
-(type: #export (Phase anchor expression statement)
- (extension.Phase (State anchor expression statement) Synthesis expression))
-
-(type: #export (Handler anchor expression statement)
- (extension.Handler (State anchor expression statement) Synthesis expression))
-
-(type: #export (Bundle anchor expression statement)
- (extension.Bundle (State anchor expression statement) Synthesis expression))
+(do-template [ ]
+ [(type: #export ( anchor expression statement)
+ ( (State anchor expression statement) Synthesis expression))]
+
+ [State+ extension.State]
+ [Operation extension.Operation]
+ [Phase extension.Phase]
+ [Handler extension.Handler]
+ [Bundle extension.Bundle]
+ )
(def: #export (state host)
(All [anchor expression statement]
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 350a0e913..702f7f342 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -42,7 +42,7 @@
[compiler
[host
[".H" scheme]]
- [default
+ ["._" default
["._" evaluation]
[phase
["._" translation
@@ -55,7 +55,9 @@
["._scheme" case]
["._scheme" extension]
["._scheme" extension/common]
- ["._scheme" expression]]]]
+ ["._scheme" expression]]]
+ [extension
+ ["._" statement]]]
["._default" cache]
[repl
["._" type]]]
@@ -65,6 +67,7 @@
["._meta_io" archive]]
["._meta" archive]
["._meta" cache]]]]
+ ## TODO: Must have 100% coverage on tests.
[test
["_." lux]
[lux
@@ -104,7 +107,7 @@
["_." product]
["_." sum]
[number
- ## "_." number ## TODO: Specially troublesome...
+ ## "_." number ## TODO: FIX Specially troublesome...
["_." i64]
["_." ratio]
["_." complex]]
@@ -145,7 +148,7 @@
["poly_." functor]]]
["_." type
["_." check]
- ## ["_." implicit] ## TODO: Specially troublesome...
+ ## ["_." implicit] ## TODO: FIX Specially troublesome...
["_." resource]]
[compiler
[default
@@ -166,7 +169,7 @@
["_.S" function]]]]]
[world
["_." binary]
- ## ["_." file] ## TODO: Specially troublesome...
+ ## ["_." file] ## TODO: FIX Specially troublesome...
[net
["_." tcp]
["_." udp]]]]]
--
cgit v1.2.3