diff options
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r-- | new-luxc/source/luxc/cache/description.lux | 139 |
1 files changed, 0 insertions, 139 deletions
diff --git a/new-luxc/source/luxc/cache/description.lux b/new-luxc/source/luxc/cache/description.lux deleted file mode 100644 index 7706d03b1..000000000 --- a/new-luxc/source/luxc/cache/description.lux +++ /dev/null @@ -1,139 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["p" parser "parser/" Monad<Parser>] - ["ex" exception #+ exception:]) - (data [product] - ["e" error #+ Error] - [text "text/" Eq<Text>] - text/format - (coll [list "list/" Functor<List>])) - (macro [code] - ["s" syntax #+ Syntax]) - [lang])) - -(exception: #export (invalid-lux-version {version Text}) - (ex.report ["Expected: " lang.version] - [" Actual: " version])) - -(def: (write-type type) - (-> Type Code) - (case type - (#.Primitive name params) - (` ("Primitive" - (~ (code.text name)) - (~+ (list/map write-type params)))) - - (^template [<tag> <description>] - (<tag> left right) - (` (<description> (~ (write-type left)) (~ (write-type right))))) - ([#.Sum "Sum"] - [#.Product "Product"] - [#.Function "Function"] - [#.Apply "Apply"]) - - (^template [<tag> <description>] - (<tag> id) - (` (<description> (~ (code.nat id))))) - ([#.Parameter "Parameter"] - [#.Var "Var"] - [#.Ex "Ex"]) - - (^template [<tag> <description>] - (<tag> env body) - (` (<description> (~ (code.tuple (list/map write-type env))) - (~ (write-type body))))) - ([#.UnivQ "UnivQ"] - [#.ExQ "ExQ"]) - - (#.Named name anonymous) - (` ("Named" (~ (code.symbol name)) (~ (write-type anonymous)))))) - -(def: read-type - (Syntax Type) - (let [tagged (: (All [a] (-> Text (Syntax a) (Syntax a))) - (function (_ tag syntax) - (s.form (p.after (s.this (code.text tag)) syntax)))) - binary (: (-> Text (Syntax Type) (Syntax [Type Type])) - (function (_ tag read-type) - (tagged tag (p.seq read-type read-type)))) - indexed (: (-> Text (Syntax Nat)) - (function (_ tag) - (tagged tag s.nat))) - quantified (: (-> Text (Syntax Type) (Syntax [(List Type) Type])) - (function (_ tag read-type) - (tagged tag (p.seq (s.tuple (p.some read-type)) - read-type))))] - (p.rec - (function (_ read-type) - ($_ p.alt - (tagged "Primitive" (p.seq s.text (p.some read-type))) - (binary "Sum" read-type) - (binary "Product" read-type) - (binary "Function" read-type) - (indexed "Parameter") - (indexed "Var") - (indexed "Ex") - (quantified "UnivQ" read-type) - (quantified "ExQ" read-type) - (binary "Apply" read-type) - (tagged "Named" (p.seq s.symbol read-type)) - ))))) - -(def: (write-definition [type annotations value]) - (-> Definition Code) - (` {"type" (~ (write-type type)) - "annotations" (~ annotations)})) - -(def: read-definition - (Syntax Definition) - (s.record ($_ p.seq - (p.after (s.this (` "type")) read-type) - (p.after (s.this (` "annotations")) s.any) - (parser/wrap [])))) - -(def: (write-aliases aliases) - (-> (List [Text Text]) Code) - (|> aliases (list/map (product.both code.text code.text)) code.record)) - -(def: read-aliases - (Syntax (List [Text Text])) - (s.record (p.some (p.seq s.text s.text)))) - -(def: #export (write lux-file module) - (-> Text Module Code) - (` {"lux version" (~ (code.text lang.version)) - "lux file" (~ (code.text lux-file)) - "hash" (~ (code.nat (get@ #.module-hash module))) - "aliases" (~ (write-aliases (get@ #.module-aliases module))) - "definitions" (~ (code.record (list/map (product.both code.text write-definition) - (get@ #.definitions module)))) - "imports" (~ (code.tuple (list/map code.text (get@ #.imports module)))) - "annotations" (~ (case (get@ #.module-annotations module) - #.None - (' "None") - - (#.Some annotations) - (` ("Some" (~ annotations))))) - })) - -(def: #export (read description) - (-> Code (Error [Text Module])) - (<| (s.run (list description)) - (s.record (do p.Monad<Parser> - [lux-version (p.after (s.this (` "lux version")) s.text) - _ (p.assert (ex.construct invalid-lux-version lux-version) - (text/= lang.version lux-version))] - ($_ p.seq - (p.after (s.this (` "lux file")) s.text) - ($_ p.seq - (p.after (s.this (` "hash")) s.nat) - (p.after (s.this (` "aliases")) read-aliases) - (p.after (s.this (` "definitions")) (s.record (p.some (p.seq s.text read-definition)))) - (p.after (s.this (` "imports")) (s.tuple (p.some s.text))) - (parser/wrap (list)) - (parser/wrap (list)) - (p.after (s.this (` "annotations")) (p.alt (s.this (` "None")) - (s.form (p.after (s.this (` "Some")) - s.any)))) - (parser/wrap #.Cached))))))) |