From 342cc20371fd43a6d6ac93620283072dbdcc26ac Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 24 Dec 2017 18:10:12 -0400 Subject: - Minor refactorings and bug fixes. --- stdlib/source/lux/data/number/ratio.lux | 14 +- stdlib/source/lux/data/text/lexer.lux | 218 ++++++++++++++++---------------- stdlib/source/lux/macro.lux | 32 ++++- stdlib/source/lux/macro/syntax.lux | 84 ++++++------ stdlib/source/lux/math.lux | 44 ++++--- 5 files changed, 215 insertions(+), 177 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 8342c9d28..a56a51433 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -7,8 +7,8 @@ codec monad ["p" parser]) - (data [number "n/" Codec] - [text "Text/" Monoid] + (data [number "nat/" Codec] + [text "text/" Monoid] text/format ["E" error] [product] @@ -23,7 +23,7 @@ (def: (normalize (^slots [#numerator #denominator])) (-> Ratio Ratio) - (let [common (math.gcd numerator denominator)] + (let [common (math.n/gcd numerator denominator)] {#numerator (n// common numerator) #denominator (n// common denominator)})) @@ -128,15 +128,15 @@ (def: part-encode (-> Nat Text) - (|>> n/encode (text.split +1) maybe.assume product.right)) + (|>> nat/encode (text.split +1) maybe.assume product.right)) (def: part-decode (-> Text (E.Error Nat)) - (|>> (format "+") n/decode)) + (|>> (format "+") nat/decode)) (struct: #export _ (Codec Text Ratio) (def: (encode (^slots [#numerator #denominator])) - ($_ Text/compose (part-encode numerator) separator (part-encode denominator))) + ($_ text/compose (part-encode numerator) separator (part-encode denominator))) (def: (decode input) (case (text.split-with separator input) @@ -148,7 +148,7 @@ #denominator denominator}))) #.None - (#.Left (Text/compose "Invalid syntax for ratio: " input))))) + (#.Left (text/compose "Invalid syntax for ratio: " input))))) (syntax: #export (ratio numerator [?denominator (p.maybe s.any)]) {#.doc (doc "Rational literals." diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 320e28d6d..1cf6c3630 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -5,7 +5,7 @@ (data [text "text/" Monoid] [product] [maybe] - ["E" error] + ["e" error] (coll [list])) (macro [code]))) @@ -27,118 +27,118 @@ ($_ text/compose "Unconsumed input: " (remaining offset tape))) (def: #export (run input lexer) - (All [a] (-> Text (Lexer a) (E.Error a))) + (All [a] (-> Text (Lexer a) (e.Error a))) (case (lexer [start-offset input]) - (#E.Error msg) - (#E.Error msg) - - (#E.Success [[end-offset _] output]) - (if (n/= end-offset (text.size input)) - (#E.Success output) - (#E.Error (unconsumed-input-error end-offset input))) - )) + (#e.Error msg) + (#e.Error msg) + + (#e.Success [[end-offset _] output]) + (if (n/= end-offset (text.size input)) + (#e.Success output) + (#e.Error (unconsumed-input-error end-offset input))) + )) (def: #export any {#.doc "Just returns the next character without applying any logic."} (Lexer Text) (function [[offset tape]] - (case (text.nth offset tape) - (#.Some output) - (#E.Success [[(n/inc offset) tape] (text.from-code output)]) + (case (text.nth offset tape) + (#.Some output) + (#e.Success [[(n/inc offset) tape] (text.from-code output)]) - _ - (#E.Error cannot-lex-error)) - )) + _ + (#e.Error cannot-lex-error)) + )) (def: #export (not p) {#.doc "Produce a character if the lexer fails."} (All [a] (-> (Lexer a) (Lexer Text))) (function [input] - (case (p input) - (#E.Error msg) - (any input) - - _ - (#E.Error "Expected to fail; yet succeeded.")))) + (case (p input) + (#e.Error msg) + (any input) + + _ + (#e.Error "Expected to fail; yet succeeded.")))) (def: #export (this reference) {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Unit)) (function [[offset tape]] - (case (text.index-of' reference offset tape) - (#.Some where) - (if (n/= offset where) - (#E.Success [[(n/+ (text.size reference) offset) tape] []]) - (#E.Error ($_ text/compose "Could not match: " (text.encode reference) " @ " (maybe.assume (text.clip' offset tape))))) + (case (text.index-of' reference offset tape) + (#.Some where) + (if (n/= offset where) + (#e.Success [[(n/+ (text.size reference) offset) tape] []]) + (#e.Error ($_ text/compose "Could not match: " (text.encode reference) " @ " (maybe.assume (text.clip' offset tape))))) - _ - (#E.Error ($_ text/compose "Could not match: " (text.encode reference)))))) + _ + (#e.Error ($_ text/compose "Could not match: " (text.encode reference)))))) (def: #export (this? reference) {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Bool)) (function [(^@ input [offset tape])] - (case (text.index-of' reference offset tape) - (^multi (#.Some where) (n/= offset where)) - (#E.Success [[(n/+ (text.size reference) offset) tape] true]) + (case (text.index-of' reference offset tape) + (^multi (#.Some where) (n/= offset where)) + (#e.Success [[(n/+ (text.size reference) offset) tape] true]) - _ - (#E.Success [input false])))) + _ + (#e.Success [input false])))) (def: #export end {#.doc "Ensure the lexer's input is empty."} (Lexer Unit) (function [(^@ input [offset tape])] - (if (n/= offset (text.size tape)) - (#E.Success [input []]) - (#E.Error (unconsumed-input-error offset tape))))) + (if (n/= offset (text.size tape)) + (#e.Success [input []]) + (#e.Error (unconsumed-input-error offset tape))))) (def: #export end? {#.doc "Ask if the lexer's input is empty."} (Lexer Bool) (function [(^@ input [offset tape])] - (#E.Success [input (n/= offset (text.size tape))]))) + (#e.Success [input (n/= offset (text.size tape))]))) (def: #export peek {#.doc "Lex the next character (without consuming it from the input)."} (Lexer Text) (function [(^@ input [offset tape])] - (case (text.nth offset tape) - (#.Some output) - (#E.Success [input (text.from-code output)]) + (case (text.nth offset tape) + (#.Some output) + (#e.Success [input (text.from-code output)]) - _ - (#E.Error cannot-lex-error)) - )) + _ + (#e.Error cannot-lex-error)) + )) (def: #export get-input {#.doc "Get all of the remaining input (without consuming it)."} (Lexer Text) (function [(^@ input [offset tape])] - (#E.Success [input (remaining offset tape)]))) + (#e.Success [input (remaining offset tape)]))) (def: #export (range bottom top) {#.doc "Only lex characters within a range."} (-> Nat Nat (Lexer Text)) (do p.Monad - [char any - #let [char' (maybe.assume (text.nth +0 char))] - _ (p.assert ($_ text/compose "Character is not within range: " (text.from-code bottom) "-" (text.from-code top)) - (and (n/>= bottom char') - (n/<= top char')))] - (wrap char))) + [char any + #let [char' (maybe.assume (text.nth +0 char))] + _ (p.assert ($_ text/compose "Character is not within range: " (text.from-code bottom) "-" (text.from-code top)) + (and (n/>= bottom char') + (n/<= top char')))] + (wrap char))) (do-template [ ] - [(def: #export - {#.doc (code.text ($_ text/compose "Only lex " " characters."))} - (Lexer Text) - (range (char ) (char )))] + [(def: #export + {#.doc (code.text ($_ text/compose "Only lex " " characters."))} + (Lexer Text) + (range (char ) (char )))] - [upper "A" "Z" "uppercase"] - [lower "a" "z" "lowercase"] - [decimal "0" "9" "decimal"] - [octal "0" "7" "octal"] - ) + [upper "A" "Z" "uppercase"] + [lower "a" "z" "lowercase"] + [decimal "0" "9" "decimal"] + [octal "0" "7" "octal"] + ) (def: #export alpha {#.doc "Only lex alphabetic characters."} @@ -162,42 +162,42 @@ {#.doc "Only lex characters that are part of a piece of text."} (-> Text (Lexer Text)) (function [[offset tape]] - (case (text.nth offset tape) - (#.Some output) - (let [output (text.from-code output)] - (if (text.contains? output options) - (#E.Success [[(n/inc offset) tape] output]) - (#E.Error ($_ text/compose "Character (" output ") is not one of: " options)))) + (case (text.nth offset tape) + (#.Some output) + (let [output (text.from-code output)] + (if (text.contains? output options) + (#e.Success [[(n/inc offset) tape] output]) + (#e.Error ($_ text/compose "Character (" output ") is not one of: " options)))) - _ - (#E.Error cannot-lex-error)))) + _ + (#e.Error cannot-lex-error)))) (def: #export (none-of options) {#.doc "Only lex characters that are not part of a piece of text."} (-> Text (Lexer Text)) (function [[offset tape]] - (case (text.nth offset tape) - (#.Some output) - (let [output (text.from-code output)] - (if (.not (text.contains? output options)) - (#E.Success [[(n/inc offset) tape] output]) - (#E.Error ($_ text/compose "Character (" output ") is one of: " options)))) + (case (text.nth offset tape) + (#.Some output) + (let [output (text.from-code output)] + (if (.not (text.contains? output options)) + (#e.Success [[(n/inc offset) tape] output]) + (#e.Error ($_ text/compose "Character (" output ") is one of: " options)))) - _ - (#E.Error cannot-lex-error)))) + _ + (#e.Error cannot-lex-error)))) (def: #export (satisfies p) {#.doc "Only lex characters that satisfy a predicate."} (-> (-> Nat Bool) (Lexer Text)) (function [[offset tape]] - (case (text.nth offset tape) - (#.Some output) - (if (p output) - (#E.Success [[(n/inc offset) tape] (text.from-code output)]) - (#E.Error ($_ text/compose "Character does not satisfy predicate: " (text.from-code output)))) + (case (text.nth offset tape) + (#.Some output) + (if (p output) + (#e.Success [[(n/inc offset) tape] (text.from-code output)]) + (#e.Error ($_ text/compose "Character does not satisfy predicate: " (text.from-code output)))) - _ - (#E.Error cannot-lex-error)))) + _ + (#e.Error cannot-lex-error)))) (def: #export space {#.doc "Only lex white-space."} @@ -207,32 +207,32 @@ (def: #export (seq left right) (-> (Lexer Text) (Lexer Text) (Lexer Text)) (do p.Monad - [=left left - =right right] - (wrap ($_ text/compose =left =right)))) + [=left left + =right right] + (wrap ($_ text/compose =left =right)))) (do-template [ ] - [(def: #export ( p) - {#.doc } - (-> (Lexer Text) (Lexer Text)) - (|> p (:: p.Monad map text.concat)))] + [(def: #export ( p) + {#.doc } + (-> (Lexer Text) (Lexer Text)) + (|> p (:: p.Monad map text.concat)))] - [some p.some "Lex some characters as a single continuous text."] - [many p.many "Lex many characters as a single continuous text."] - ) + [some p.some "Lex some characters as a single continuous text."] + [many p.many "Lex many characters as a single continuous text."] + ) (do-template [ ] - [(def: #export ( n p) - {#.doc } - (-> Nat (Lexer Text) (Lexer Text)) - (do p.Monad - [] - (|> p ( n) (:: @ map text.concat))))] - - [exactly p.exactly "Lex exactly N characters."] - [at-most p.at-most "Lex at most N characters."] - [at-least p.at-least "Lex at least N characters."] - ) + [(def: #export ( n p) + {#.doc } + (-> Nat (Lexer Text) (Lexer Text)) + (do p.Monad + [] + (|> p ( n) (:: @ map text.concat))))] + + [exactly p.exactly "Lex exactly N characters."] + [at-most p.at-most "Lex at most N characters."] + [at-least p.at-least "Lex at least N characters."] + ) (def: #export (between from to p) {#.doc "Lex between N and M characters."} @@ -249,9 +249,9 @@ {#.doc "Run a lexer with the given input, instead of the real one."} (All [a] (-> Text (Lexer a) (Lexer a))) (function [real-input] - (case (run local-input lexer) - (#E.Error error) - (#E.Error error) + (case (run local-input lexer) + (#e.Error error) + (#e.Error error) - (#E.Success value) - (#E.Success [real-input value])))) + (#e.Success value) + (#e.Success [real-input value])))) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index b32fc0aa1..7a01c98be 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -427,6 +427,34 @@ #.None (f x2) (#.Some y) (#.Some y))) +(def: (find-type-var idx bindings) + (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) + (case bindings + #.Nil + #.None + + (#.Cons [var bound] bindings') + (if (n/= idx var) + bound + (find-type-var idx bindings')))) + +(def: (clean-type type) + (-> Type (Meta Type)) + (case type + (#.Var var) + (function [compiler] + (case (|> compiler + (get@ [#.type-context #.var-bindings]) + (find-type-var var)) + (^or #.None (#.Some (#.Var _))) + (#e.Success [compiler type]) + + (#.Some type') + (#e.Success [compiler type']))) + + _ + (:: Monad wrap type))) + (def: #export (find-var-type name) {#.doc "Looks-up the type of a local variable somewhere in the environment."} (-> Text (Meta Type)) @@ -447,7 +475,7 @@ (get@ [#.captured #.mappings] scope)))] (wrap type)) (#.Some var-type) - (#e.Success [compiler var-type]) + ((clean-type var-type) compiler) #.None (#e.Error ($_ text/compose "Unknown variable: " name)))))) @@ -486,7 +514,7 @@ (-> Ident (Meta Type)) (do Monad [[def-type def-data def-value] (find-def name)] - (wrap def-type))) + (clean-type def-type))) (def: #export (find-type name) {#.doc "Looks-up the type of either a local variable or a definition."} diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index e31b8c876..73eda1e8a 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -11,7 +11,7 @@ (coll [list "list/" Functor]) [product] [maybe] - ["E" error])) + ["e" error])) (// [code "code/" Eq])) ## [Utils] @@ -38,8 +38,8 @@ (Syntax Code) (function [tokens] (case tokens - #.Nil (#E.Error "There are no tokens to parse!") - (#.Cons [t tokens']) (#E.Success [tokens' t])))) + #.Nil (#e.Error "There are no tokens to parse!") + (#.Cons [t tokens']) (#e.Success [tokens' t])))) (do-template [ ] [(def: #export @@ -48,10 +48,10 @@ (function [tokens] (case tokens (#.Cons [[_ ( x)] tokens']) - (#E.Success [tokens' x]) + (#e.Success [tokens' x]) _ - (#E.Error ($_ text/compose "Cannot parse " (remaining-inputs tokens))))))] + (#e.Error ($_ text/compose "Cannot parse " (remaining-inputs tokens))))))] [ bool Bool #.Bool bool.Eq "bool"] [ nat Nat #.Nat number.Eq "nat"] @@ -73,10 +73,10 @@ remaining (if is-it? tokens' tokens)] - (#E.Success [remaining is-it?])) + (#e.Success [remaining is-it?])) _ - (#E.Success [tokens false])))) + (#e.Success [tokens false])))) (def: #export (this ast) {#.doc "Ensures the given Code is the next input."} @@ -85,12 +85,12 @@ (case tokens (#.Cons [token tokens']) (if (code/= ast token) - (#E.Success [tokens' []]) - (#E.Error ($_ text/compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token) + (#e.Success [tokens' []]) + (#e.Error ($_ text/compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token) (remaining-inputs tokens)))) _ - (#E.Error "There are no tokens to parse!")))) + (#e.Error "There are no tokens to parse!")))) (do-template [ ] [(def: #export @@ -99,10 +99,10 @@ (function [tokens] (case tokens (#.Cons [[_ ( ["" x])] tokens']) - (#E.Success [tokens' x]) + (#e.Success [tokens' x]) _ - (#E.Error ($_ text/compose "Cannot parse local " (remaining-inputs tokens))))))] + (#e.Error ($_ text/compose "Cannot parse local " (remaining-inputs tokens))))))] [local-symbol #.Symbol "symbol"] [ local-tag #.Tag "tag"] @@ -117,11 +117,11 @@ (case tokens (#.Cons [[_ ( members)] tokens']) (case (p members) - (#E.Success [#.Nil x]) (#E.Success [tokens' x]) - _ (#E.Error ($_ text/compose "Syntax was expected to fully consume " (remaining-inputs tokens)))) + (#e.Success [#.Nil x]) (#e.Success [tokens' x]) + _ (#e.Error ($_ text/compose "Syntax was expected to fully consume " (remaining-inputs tokens)))) _ - (#E.Error ($_ text/compose "Cannot parse " (remaining-inputs tokens))))))] + (#e.Error ($_ text/compose "Cannot parse " (remaining-inputs tokens))))))] [ form #.Form "form"] [tuple #.Tuple "tuple"] @@ -135,53 +135,53 @@ (case tokens (#.Cons [[_ (#.Record pairs)] tokens']) (case (p (join-pairs pairs)) - (#E.Success [#.Nil x]) (#E.Success [tokens' x]) - _ (#E.Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) + (#e.Success [#.Nil x]) (#e.Success [tokens' x]) + _ (#e.Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) _ - (#E.Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) + (#e.Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) (def: #export end! {#.doc "Ensures there are no more inputs."} (Syntax Unit) (function [tokens] (case tokens - #.Nil (#E.Success [tokens []]) - _ (#E.Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + #.Nil (#e.Success [tokens []]) + _ (#e.Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) (def: #export end? {#.doc "Checks whether there are no more inputs."} (Syntax Bool) (function [tokens] (case tokens - #.Nil (#E.Success [tokens true]) - _ (#E.Success [tokens false])))) + #.Nil (#e.Success [tokens true]) + _ (#e.Success [tokens false])))) (def: #export (on compiler action) {#.doc "Run a Lux operation as if it was a Syntax parser."} (All [a] (-> Compiler (Meta a) (Syntax a))) (function [input] (case (macro.run compiler action) - (#E.Error error) - (#E.Error error) + (#e.Error error) + (#e.Error error) - (#E.Success value) - (#E.Success [input value]) + (#e.Success value) + (#e.Success [input value]) ))) (def: #export (run inputs syntax) - (All [a] (-> (List Code) (Syntax a) (E.Error a))) + (All [a] (-> (List Code) (Syntax a) (e.Error a))) (case (syntax inputs) - (#E.Error error) - (#E.Error error) + (#e.Error error) + (#e.Error error) - (#E.Success [unconsumed value]) + (#e.Success [unconsumed value]) (case unconsumed #.Nil - (#E.Success value) + (#e.Success value) _ - (#E.Error (text/compose "Unconsumed inputs: " + (#e.Error (text/compose "Unconsumed inputs: " (|> (list/map code.to-text unconsumed) (text.join-with ", "))))))) @@ -189,7 +189,7 @@ {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."} (All [a] (-> (List Code) (Syntax a) (Syntax a))) (function [real] - (do E.Monad + (do e.Monad [value (run inputs syntax)] (wrap [real value])))) @@ -257,18 +257,18 @@ (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state)) (~ meta) ("lux case" (..run (~ g!tokens) - (: (Syntax (Meta (List Code))) - (do (~! p.Monad) - [(~+ (join-pairs vars+parsers))] - ((~' wrap) (do (~! macro.Monad) - [] - (~ body)))))) - {(#E.Success (~ g!body)) + (: (..Syntax (Meta (List Code))) + ((~! do) (~! p.Monad) + [(~+ (join-pairs vars+parsers))] + ((~' wrap) ((~! do) (~! macro.Monad) + [] + (~ body)))))) + {(#e.Success (~ g!body)) ((~ g!body) (~ g!state)) - (#E.Error (~ g!error)) + (#e.Error (~ g!error)) (let [(~ g!text/join-with) (~! text.join-with)] - (#E.Error ((~ g!text/join-with) ": " (list (~ error-msg) (~ g!error)))))}))))))) + (#e.Error ((~ g!text/join-with) ": " (list (~ error-msg) (~ g!error)))))}))))))) _ (macro.fail "Wrong syntax for syntax:")))) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index c8cfe89df..1e18af14e 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -74,23 +74,33 @@ (root2 (f/+ (pow 2.0 catA) (pow 2.0 catB)))) -(def: #export (gcd a b) - {#.doc "Greatest Common Divisor."} - (-> Nat Nat Nat) - (case b - +0 a - _ (gcd b (n/% b a)))) - -(def: #export (lcm x y) - {#.doc "Least Common Multiple."} - (-> Nat Nat Nat) - (case [x y] - (^or [_ +0] [+0 _]) - +0 - - _ - (|> x (n// (gcd x y)) (n/* y)) - )) +(do-template [ <*> <->] + [(def: ( param subject) + (-> ) + (let [exact (|> subject ( param) (<*> param))] + (|> subject (<-> exact)))) + + (def: #export ( a b) + {#.doc "Greatest Common Divisor."} + (-> ) + (case b + a + _ ( b ( b a)))) + + (def: #export ( a b) + {#.doc "Least Common Multiple."} + (-> ) + (case [a b] + (^or [_ ] [ _]) + + + _ + (|> a ( ( a b)) (<*> b)) + ))] + + [Nat n/mod n/gcd n/lcm +0 n/* n// n/-] + [Int i/mod i/gcd i/lcm 0 i/* i// i/-] + ) ## [Syntax] (type: #rec Infix -- cgit v1.2.3