From 2e86fefe6f15877e8c46a45411a9cbd04b26e2e3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 5 Dec 2017 22:55:11 -0400 Subject: - WIP: Caching. --- .../source/luxc/module/descriptor/annotation.lux | 81 ------------ new-luxc/source/luxc/module/descriptor/common.lux | 37 ------ new-luxc/source/luxc/module/descriptor/type.lux | 145 --------------------- 3 files changed, 263 deletions(-) delete mode 100644 new-luxc/source/luxc/module/descriptor/annotation.lux delete mode 100644 new-luxc/source/luxc/module/descriptor/common.lux delete mode 100644 new-luxc/source/luxc/module/descriptor/type.lux (limited to 'new-luxc/source/luxc/module') 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]) - [number] - error - (coll [list "L/" Functor]))) - ["&" ../common] - [luxc ["&." parser]]) - -(def: dummy-cursor Cursor ["" +1 +0]) - -(do-template [ ] - [(def: &.Signal )] - - [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 [ ] - ( value) - (format - ( 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 - [ (do-template [ ] - [(do l.Monad - [])])] - ($_ l.either - - (|> ... (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]) - (coll [list "L/" Functor])))) - -(type: #export Signal Text) - -(do-template [ ] - [(def: #export Signal )] - - [cons-signal "\u0005"] - [nil-signal "\u0006"] - [stop-signal "\u0007"] - ) - -(do-template [ ] - [(def: #export Signal )] - - [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]) - [number] - ["e" error] - (coll [list "L/" Functor])) - (lang [type "type/" Eq])) - ["&" ../common]) - -(do-template [ ] - [(def: &.Signal )] - - [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 [ ] - ( left right) - (format (encode-type left) (encode-type right))) - ([#.Product product-signal] - [#.Sum sum-signal] - [#.Function function-signal] - [#.App application-signal]) - - - (^template [ ] - ( env body) - (format (&.encode-list encode-type env) (encode-type body))) - ([#.UnivQ uq-signal] - [#.ExQ eq-signal]) - - (^template [ ] - ( idx) - (format (%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 - [ (do-template [ ] - [(|> (l/wrap ) (l.after (l.text )))] - - [Type type-signal] - [#.Void void-signal] - [#.Unit unit-signal]) - (do-template [ ] - [(do l.Monad - [_ (l.text ) - left type-decoder - right type-decoder] - (wrap ( left right)))] - - [#.Product product-signal] - [#.Sum sum-signal] - [#.Function function-signal] - [#.App application-signal]) - (do-template [ ] - [(do l.Monad - [_ (l.text ) - env (&.decode-list type-decoder) - body type-decoder] - (wrap ( env body)))] - - [#.UnivQ uq-signal] - [#.ExQ eq-signal]) - (do-template [ ] - [(do l.Monad - [_ (l.text ) - id (l.codec number.Codec - (l.some' l.digit)) - _ (l.text &.stop-signal)] - (wrap ( (int-to-nat id))))] - - [#.Bound bound-signal] - [#.Ex ex-signal] - [#.Var var-signal])] - ($_ l.either - (do l.Monad - [_ (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))) - - - - - (do l.Monad - [_ (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)) -- cgit v1.2.3