diff options
Diffstat (limited to 'new-luxc/source/luxc/module')
-rw-r--r-- | new-luxc/source/luxc/module/descriptor/annotation.lux | 81 | ||||
-rw-r--r-- | new-luxc/source/luxc/module/descriptor/common.lux | 37 | ||||
-rw-r--r-- | new-luxc/source/luxc/module/descriptor/type.lux | 145 |
3 files changed, 0 insertions, 263 deletions
diff --git a/new-luxc/source/luxc/module/descriptor/annotation.lux b/new-luxc/source/luxc/module/descriptor/annotation.lux deleted file mode 100644 index 8ac220d0f..000000000 --- a/new-luxc/source/luxc/module/descriptor/annotation.lux +++ /dev/null @@ -1,81 +0,0 @@ -(.module: - lux - (lux (control codec - monad) - (data [text] - (text format - ["l" lexer "l/" Monad<Lexer>]) - [number] - error - (coll [list "L/" Functor<List>]))) - ["&" ../common] - [luxc ["&." parser]]) - -(def: dummy-cursor Cursor ["" +1 +0]) - -(do-template [<name> <code>] - [(def: <name> &.Signal <code>)] - - [ident-signal "@"] - [bool-signal "B"] - [nat-signal "N"] - [int-signal "I"] - [deg-signal "D"] - [frac-signal "R"] - [text-signal "T"] - [list-signal "%"] - [dict-signal "#"] - ) - -(def: (encode-ident [module name]) - (-> Ident Text) - (format ident-signal - module &.ident-separator name - &.stop-signal)) - -(def: (encode-text value) - (-> Text Text) - (format text-signal - (%t value) - &.stop-signal)) - -(def: (encode-ann-value value) - (-> Ann-Value Text) - (case value - (^template [<tag> <signal> <encoder>] - (<tag> value) - (format <signal> - (<encoder> value) - &.stop-signal)) - ([#.BoolA bool-signal %b] - [#.NatA nat-signal %n] - [#.IntA int-signal %i] - [#.DegA deg-signal %d] - [#.FracA frac-signal %r] - [#.TextA text-signal %t] - [#.IdentA ident-signal %ident] - [#.ListA list-signal (&.encode-list encode-ann-value)] - [#.DictA dict-signal (&.encode-list (function [[k v]] - (format (encode-text k) - (encode-ann-value v))))]))) - -(def: ann-value-decoder - (l.Lexer Ann-Value) - (with-expansions - [<simple> (do-template [<tag> <lexer> <signal>] - [(do l.Monad<Lexer> - [])])] - ($_ l.either - <simple> - (|> ... (l.after (l.text bool-signal))) - ))) - -(def: encode-anns - (-> Anns Text) - (&.encode-list (function [[ident value]] - (format (encode-ident ident) - (encode-ann-value value))))) - -(struct: #export _ (Codec Text Anns) - (def: encode encode-anns) - (def: decode decode-anns)) diff --git a/new-luxc/source/luxc/module/descriptor/common.lux b/new-luxc/source/luxc/module/descriptor/common.lux deleted file mode 100644 index b123fe852..000000000 --- a/new-luxc/source/luxc/module/descriptor/common.lux +++ /dev/null @@ -1,37 +0,0 @@ -(.module: - lux - (lux (data [text] - (text format - ["l" lexer "l/" Monad<Lexer>]) - (coll [list "L/" Functor<List>])))) - -(type: #export Signal Text) - -(do-template [<name> <code>] - [(def: #export <name> Signal <code>)] - - [cons-signal "\u0005"] - [nil-signal "\u0006"] - [stop-signal "\u0007"] - ) - -(do-template [<name> <code>] - [(def: #export <name> Signal <code>)] - - [ident-separator "."] - ) - -(def: #export (encode-list encode-elem types) - (All [a] (-> (-> a Text) (List a) Text)) - (format (|> (L/map encode-elem types) - (text.join-with cons-signal)) - nil-signal)) - -(def: #export (decode-list decode-elem) - (All [a] (-> (l.Lexer a) (l.Lexer (List a)))) - (l.alt (<| (l.after (l.text nil-signal)) - (l/wrap [])) - (<| (l.seq decode-elem) - (l.after (l.text cons-signal)) - (decode-list decode-elem)))) - diff --git a/new-luxc/source/luxc/module/descriptor/type.lux b/new-luxc/source/luxc/module/descriptor/type.lux deleted file mode 100644 index d72229832..000000000 --- a/new-luxc/source/luxc/module/descriptor/type.lux +++ /dev/null @@ -1,145 +0,0 @@ -(.module: - lux - (lux (control codec - monad) - (data [text] - (text format - ["l" lexer "l/" Monad<Lexer>]) - [number] - ["e" error] - (coll [list "L/" Functor<List>])) - (lang [type "type/" Eq<Type>])) - ["&" ../common]) - -(do-template [<name> <code>] - [(def: <name> &.Signal <code>)] - - [type-signal "T"] - [primitive-signal "^"] - [void-signal "0"] - [unit-signal "1"] - [product-signal "*"] - [sum-signal "+"] - [function-signal ">"] - [application-signal "%"] - [uq-signal "U"] - [eq-signal "E"] - [bound-signal "$"] - [ex-signal "!"] - [var-signal "?"] - [named-signal "@"] - ) - -(def: (encode-type type) - (-> Type Text) - (if (or (is Type type) - (type/= Type type)) - type-signal - (case type - (#.Primitive name params) - (format primitive-signal name &.stop-signal (&.encode-list encode-type params)) - - #.Void - void-signal - - #.Unit - unit-signal - - (^template [<tag> <prefix>] - (<tag> left right) - (format <prefix> (encode-type left) (encode-type right))) - ([#.Product product-signal] - [#.Sum sum-signal] - [#.Function function-signal] - [#.App application-signal]) - - - (^template [<tag> <prefix>] - (<tag> env body) - (format <prefix> (&.encode-list encode-type env) (encode-type body))) - ([#.UnivQ uq-signal] - [#.ExQ eq-signal]) - - (^template [<tag> <prefix>] - (<tag> idx) - (format <prefix> (%i (nat-to-int idx)) &.stop-signal)) - ([#.Bound bound-signal] - [#.Ex ex-signal] - [#.Var var-signal]) - - (#.Named [module name] type*) - (format named-signal module &.ident-separator name &.stop-signal (encode-type type*)) - ))) - -(def: type-decoder - (l.Lexer Type) - (l.rec - (function [type-decoder] - (with-expansions - [<simple> (do-template [<type> <signal>] - [(|> (l/wrap <type>) (l.after (l.text <signal>)))] - - [Type type-signal] - [#.Void void-signal] - [#.Unit unit-signal]) - <combinators> (do-template [<tag> <prefix>] - [(do l.Monad<Lexer> - [_ (l.text <prefix>) - left type-decoder - right type-decoder] - (wrap (<tag> left right)))] - - [#.Product product-signal] - [#.Sum sum-signal] - [#.Function function-signal] - [#.App application-signal]) - <abstractions> (do-template [<tag> <prefix>] - [(do l.Monad<Lexer> - [_ (l.text <prefix>) - env (&.decode-list type-decoder) - body type-decoder] - (wrap (<tag> env body)))] - - [#.UnivQ uq-signal] - [#.ExQ eq-signal]) - <wildcards> (do-template [<tag> <prefix>] - [(do l.Monad<Lexer> - [_ (l.text <prefix>) - id (l.codec number.Codec<Text,Int> - (l.some' l.digit)) - _ (l.text &.stop-signal)] - (wrap (<tag> (int-to-nat id))))] - - [#.Bound bound-signal] - [#.Ex ex-signal] - [#.Var var-signal])] - ($_ l.either - (do l.Monad<Lexer> - [_ (l.text primitive-signal) - name (l.many' (l.none-of &.stop-signal)) - _ (l.text &.stop-signal) - params (&.decode-list type-decoder)] - (wrap (#.Primitive name params))) - <simple> - <combinators> - <abstractions> - <wildcards> - (do l.Monad<Lexer> - [_ (l.text named-signal) - module (l.some' (l.none-of &.ident-separator)) - _ (l.text &.ident-separator) - name (l.many' (l.none-of &.stop-signal)) - _ (l.text &.stop-signal) - unnamed type-decoder] - (wrap (#.Named [module name] unnamed))) - ))))) - -(def: (decode-type input) - (-> Text (e.Error Type)) - (|> type-decoder - (l.before l.end) - (l.run input))) - -(struct: #export _ (Codec Text Type) - (def: encode encode-type) - (def: decode decode-type)) |