From 4242e4d3b18eb532ae18e8b38e85ad1ee1988e02 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 15 May 2018 19:52:04 -0400
Subject: - Migrated primitive analysis to stdlib.
---
new-luxc/source/luxc/lang.lux | 145 -----------------------
new-luxc/source/luxc/lang/analysis/common.lux | 9 --
new-luxc/source/luxc/lang/analysis/primitive.lux | 30 -----
3 files changed, 184 deletions(-)
delete mode 100644 new-luxc/source/luxc/lang/analysis/primitive.lux
(limited to 'new-luxc/source/luxc')
diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux
index bba58f421..1060eeb8e 100644
--- a/new-luxc/source/luxc/lang.lux
+++ b/new-luxc/source/luxc/lang.lux
@@ -16,72 +16,6 @@
(type: #export Eval
(-> Type Code (Meta Top)))
-(type: #export Analyser
- (-> Code (Meta la.Analysis)))
-
-(def: #export version Text "0.6.0")
-
-(def: #export (fail message)
- (All [a] (-> Text (Meta a)))
- (do macro.Monad
- [[file line col] macro.cursor
- #let [location (format file
- "," (|> line nat-to-int %i)
- "," (|> col nat-to-int %i))]]
- (macro.fail (format message "\n\n"
- "@ " location))))
-
-(def: #export (throw exception message)
- (All [e a] (-> (ex.Exception e) e (Meta a)))
- (fail (ex.construct exception message)))
-
-(syntax: #export (assert exception message test)
- (wrap (list (` (if (~ test)
- (:: macro.Monad (~' wrap) [])
- (..throw (~ exception) (~ message)))))))
-
-(def: #export (with-type expected action)
- (All [a] (-> Type (Meta a) (Meta a)))
- (function (_ compiler)
- (case (action (set@ #.expected (#.Some expected) compiler))
- (#e.Success [compiler' output])
- (let [old-expected (get@ #.expected compiler)]
- (#e.Success [(set@ #.expected old-expected compiler')
- output]))
-
- (#e.Error error)
- (#e.Error error))))
-
-(def: #export (with-type-env action)
- (All [a] (-> (tc.Check a) (Meta a)))
- (function (_ compiler)
- (case (action (get@ #.type-context compiler))
- (#e.Error error)
- ((fail error) compiler)
-
- (#e.Success [context' output])
- (#e.Success [(set@ #.type-context context' compiler)
- output]))))
-
-(def: #export (with-fresh-type-env action)
- (All [a] (-> (Meta a) (Meta a)))
- (function (_ compiler)
- (let [old (get@ #.type-context compiler)]
- (case (action (set@ #.type-context tc.fresh-context compiler))
- (#e.Success [compiler' output])
- (#e.Success [(set@ #.type-context old compiler')
- output])
-
- output
- output))))
-
-(def: #export (infer actualT)
- (-> Type (Meta Top))
- (do macro.Monad
- [expectedT macro.expected-type]
- (with-type-env
- (tc.check expectedT actualT))))
-
(def: #export (pl-get key table)
(All [a] (-> Text (List [Text a]) (Maybe a)))
(case table
@@ -126,85 +60,6 @@
(#.Cons [k' (f v')] table')
(#.Cons [k' v'] (pl-update key f table')))))
-(def: #export (with-source-code source action)
- (All [a] (-> Source (Meta a) (Meta a)))
- (function (_ compiler)
- (let [old-source (get@ #.source compiler)]
- (case (action (set@ #.source source compiler))
- (#e.Error error)
- (#e.Error error)
-
- (#e.Success [compiler' output])
- (#e.Success [(set@ #.source old-source compiler')
- output])))))
-
-(def: #export (with-stacked-errors handler action)
- (All [a] (-> (-> [] Text) (Meta a) (Meta a)))
- (function (_ compiler)
- (case (action compiler)
- (#e.Success [compiler' output])
- (#e.Success [compiler' output])
-
- (#e.Error error)
- (#e.Error (if (text/= "" error)
- (handler [])
- (format (handler []) "\n\n-----------------------------------------\n\n" error))))))
-
-(def: fresh-bindings
- (All [k v] (Bindings k v))
- {#.counter +0
- #.mappings (list)})
-
-(def: fresh-scope
- Scope
- {#.name (list)
- #.inner +0
- #.locals fresh-bindings
- #.captured fresh-bindings})
-
-(def: #export (with-scope action)
- (All [a] (-> (Meta a) (Meta [Scope a])))
- (function (_ compiler)
- (case (action (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler))
- (#e.Success [compiler' output])
- (case (get@ #.scopes compiler')
- #.Nil
- (#e.Error "Impossible error: Drained scopes!")
-
- (#.Cons head tail)
- (#e.Success [(set@ #.scopes tail compiler')
- [head output]]))
-
- (#e.Error error)
- (#e.Error error))))
-
-(def: #export (with-current-module name action)
- (All [a] (-> Text (Meta a) (Meta a)))
- (function (_ compiler)
- (case (action (set@ #.current-module (#.Some name) compiler))
- (#e.Success [compiler' output])
- (#e.Success [(set@ #.current-module
- (get@ #.current-module compiler)
- compiler')
- output])
-
- (#e.Error error)
- (#e.Error error))))
-
-(def: #export (with-cursor cursor action)
- (All [a] (-> Cursor (Meta a) (Meta a)))
- (if (text/= "" (product.left cursor))
- action
- (function (_ compiler)
- (let [old-cursor (get@ #.cursor compiler)]
- (case (action (set@ #.cursor cursor compiler))
- (#e.Success [compiler' output])
- (#e.Success [(set@ #.cursor old-cursor compiler')
- output])
-
- (#e.Error error)
- (#e.Error error))))))
-
(def: (normalize-char char)
(-> Nat Text)
(case char
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
index c4ff4bfde..072616cfa 100644
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/common.lux
@@ -10,15 +10,6 @@
(luxc ["&" lang]
(lang analysis)))
-(def: #export (with-unknown-type action)
- (All [a] (-> (Meta a) (Meta [Type a])))
- (do macro.Monad
- [[_ varT] (&.with-type-env tc.var)
- analysis (&.with-type varT
- action)
- knownT (&.with-type-env (tc.clean varT))]
- (wrap [knownT analysis])))
-
(exception: #export (Variant-Tag-Out-Of-Bounds {message Text})
message)
diff --git a/new-luxc/source/luxc/lang/analysis/primitive.lux b/new-luxc/source/luxc/lang/analysis/primitive.lux
deleted file mode 100644
index ff7908669..000000000
--- a/new-luxc/source/luxc/lang/analysis/primitive.lux
+++ /dev/null
@@ -1,30 +0,0 @@
-(.module:
- lux
- (lux (control monad)
- [macro]
- (macro [code])
- (lang (type ["tc" check])))
- (luxc ["&" lang]
- (lang ["la" analysis #+ Analysis])))
-
-## [Analysers]
-(do-template [ ]
- [(def: #export ( value)
- (-> (Meta Analysis))
- (do macro.Monad
- [_ (&.infer )]
- (wrap ( value))))]
-
- [analyse-bool Bool code.bool]
- [analyse-nat Nat code.nat]
- [analyse-int Int code.int]
- [analyse-deg Deg code.deg]
- [analyse-frac Frac code.frac]
- [analyse-text Text code.text]
- )
-
-(def: #export analyse-unit
- (Meta Analysis)
- (do macro.Monad
- [_ (&.infer Top)]
- (wrap (` []))))
--
cgit v1.2.3