From 3175ae85d62ff6f692b8cc127f56c6569041d788 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 1 May 2017 18:15:14 -0400 Subject: - WIP: Some initial implementations for some re-written infrastructure. --- new-luxc/source/luxc/module/def.lux | 6 + .../source/luxc/module/descriptor/annotation.lux | 83 ++++++++++++ new-luxc/source/luxc/module/descriptor/common.lux | 38 ++++++ new-luxc/source/luxc/module/descriptor/type.lux | 145 +++++++++++++++++++++ 4 files changed, 272 insertions(+) create mode 100644 new-luxc/source/luxc/module/def.lux create mode 100644 new-luxc/source/luxc/module/descriptor/annotation.lux create mode 100644 new-luxc/source/luxc/module/descriptor/common.lux create 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/def.lux b/new-luxc/source/luxc/module/def.lux new file mode 100644 index 000000000..2d48b3617 --- /dev/null +++ b/new-luxc/source/luxc/module/def.lux @@ -0,0 +1,6 @@ +(;module: + lux + (lux (control monad) + (data text/format)) + (luxc ["&" base])) + diff --git a/new-luxc/source/luxc/module/descriptor/annotation.lux b/new-luxc/source/luxc/module/descriptor/annotation.lux new file mode 100644 index 000000000..9a687e02a --- /dev/null +++ b/new-luxc/source/luxc/module/descriptor/annotation.lux @@ -0,0 +1,83 @@ +(;module: + lux + (lux (control codec + monad) + (data [text] + (text format + ["l" lexer "l/" Monad]) + [char] + [number] + error + (coll [list "L/" Functor]))) + ["&" ../common] + [luxc ["&;" parser]]) + +(def: dummy-cursor Cursor ["" +0 +0]) + +(do-template [ ] + [(def: &;Signal )] + + [ident-signal "@"] + [bool-signal "B"] + [nat-signal "N"] + [int-signal "I"] + [deg-signal "D"] + [real-signal "R"] + [char-signal "C"] + [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] + [#;RealA real-signal %r] + [#;CharA char-signal %c] + [#;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) + (let% [ (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 new file mode 100644 index 000000000..60a313115 --- /dev/null +++ b/new-luxc/source/luxc/module/descriptor/common.lux @@ -0,0 +1,38 @@ +(;module: + lux + (lux (data [text] + (text format + ["l" lexer "l/" Monad]) + [char] + (coll [list "L/" Functor])))) + +(type: #export Signal Text) + +(do-template [ ] + [(def: #export Signal (|> char;char char;as-text))] + + [cons-signal +5] + [nil-signal +6] + [stop-signal +7] + ) + +(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 new file mode 100644 index 000000000..c4078ec0e --- /dev/null +++ b/new-luxc/source/luxc/module/descriptor/type.lux @@ -0,0 +1,145 @@ +(;module: + lux + (lux (control codec + monad) + (data [text] + (text format + ["l" lexer "l/" Monad]) + [char] + [number] + error + (coll [list "L/" Functor])) + [type "Type/" Eq]) + ["&" ../common]) + +(do-template [ ] + [(def: &;Signal )] + + [type-signal "T"] + [host-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 + (#;HostT name params) + (format host-signal name &;stop-signal (&;encode-list encode-type params)) + + #;VoidT + void-signal + + #;UnitT + unit-signal + + (^template [ ] + ( left right) + (format (encode-type left) (encode-type right))) + ([#;ProdT product-signal] + [#;SumT sum-signal] + [#;FunctionT function-signal] + [#;AppT 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)) + ([#;BoundT bound-signal] + [#;ExT ex-signal] + [#;VarT var-signal]) + + (#;NamedT [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] + (let% [ (do-template [ ] + [(|> (l/wrap ) (l;after (l;text )))] + + [Type type-signal] + [#;VoidT void-signal] + [#;UnitT unit-signal]) + (do-template [ ] + [(do l;Monad + [_ (l;text ) + left type-decoder + right type-decoder] + (wrap ( left right)))] + + [#;ProdT product-signal] + [#;SumT sum-signal] + [#;FunctionT function-signal] + [#;AppT 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))))] + + [#;BoundT bound-signal] + [#;ExT ex-signal] + [#;VarT var-signal])] + ($_ l;either + (do l;Monad + [_ (l;text host-signal) + name (l;many' (l;none-of &;stop-signal)) + _ (l;text &;stop-signal) + params (&;decode-list type-decoder)] + (wrap (#;HostT 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 (#;NamedT [module name] unnamed))) + ))))) + +(def: (decode-type input) + (-> Text (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