diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 33caa0a47..02de8afdc 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -332,8 +332,16 @@ Called by `imenu--generic-function'." (goto-char start))))) ;; https://www.gnu.org/software/findutils/manual/html_node/find_html/emacs-regular-expression-syntax.html -(defun altRE (&rest alternatives) - (concat "\\(" (mapconcat 'identity alternatives "\\|") "\\)")) +(defun orRE (&rest alternatives) + (concat "\\(" + (mapconcat 'identity alternatives "\\|") + "\\)")) + +(defun andRE (&rest it) + (mapconcat 'identity it "")) + +(defun some (it) + (concat it "*")) (defun literal (content) (concat "\\<" content "\\>")) @@ -344,20 +352,47 @@ Called by `imenu--generic-function'." (defun -class (characters) (concat "[^" characters "]")) +(defvar separator_of_digits (+class ",")) + +(defun digits* (characters) + (some (orRE separator_of_digits characters))) + +(defun digits (characters) + (andRE characters + (digits* characters))) + ;; https://www.emacswiki.org/emacs/RegularExpression (defconst lux-font-lock-keywords (eval-when-compile (let* ((suffix_of_binary_notation "b") (every_digit_of_binary_notation (+class "0-1")) - (binary_notation (concat every_digit_of_binary_notation suffix_of_binary_notation)) + (binary_notation (andRE every_digit_of_binary_notation suffix_of_binary_notation)) + + (suffix_of_octal_notation "o") + (every_digit_of_octal_notation (orRE every_digit_of_binary_notation (+class "2-7"))) + (octal_notation (andRE (digits every_digit_of_octal_notation) suffix_of_octal_notation)) + + (suffix_of_decimal_notation "d") + (every_digit_of_decimal_notation (orRE every_digit_of_octal_notation (+class "8-9"))) + (default_notation (digits every_digit_of_decimal_notation)) + (decimal_notation (andRE default_notation suffix_of_decimal_notation)) + + (suffix_of_hexadecimal_notation "h") + (every_digit_of_hexadecimal_notation (orRE every_digit_of_decimal_notation (+class "A-F"))) + (hexadecimal_notation (andRE every_digit_of_decimal_notation + (digits* every_digit_of_hexadecimal_notation) + suffix_of_hexadecimal_notation)) (natural_unit "[°g%‰‱]") - (decimal_unit (altRE natural_unit - "[πτ]")) + (decimal_unit (orRE natural_unit + "[πτ]")) - (natural "[0-9][0-9,]*") + (natural (orRE octal_notation + decimal_notation + hexadecimal_notation + default_notation)) - (sign (altRE "-" "\\+")) + (sign (orRE "-" "\\+")) (integer (concat sign natural)) (decimal_separator "\\.") @@ -367,10 +402,10 @@ Called by `imenu--generic-function'." decimal_unit "?")) (fraction_separator "/") - (fraction (altRE (concat natural fraction_separator natural) - (concat natural natural_unit))) - (rational (altRE (concat integer fraction_separator natural) - (concat integer natural_unit))) + (fraction (orRE (concat natural fraction_separator natural) + (concat natural natural_unit))) + (rational (orRE (concat integer fraction_separator natural) + (concat integer natural_unit))) (identifier_h|label "#") (identifier_h|type "[:upper:]") @@ -380,104 +415,103 @@ Called by `imenu--generic-function'." (identifier (concat (-class identifier_h) (-class identifier_t) "*")) (specialRE (let (;; Control - (control//flow (altRE "when" "exec" "let" "loop" "do" "be" - "if" "unless")) - (control//pattern-matching (altRE "open")) - (control//logic (altRE "and" "or")) - (control//contract (altRE "pre" "post")) - (control//polymorphism (altRE "method")) + (control//flow (orRE "when" "exec" "let" "loop" "do" "be" + "if" "unless")) + (control//pattern-matching (orRE "open")) + (control//logic (orRE "and" "or")) + (control//contract (orRE "pre" "post")) + (control//polymorphism (orRE "method")) ;; Type - (type//syntax (altRE "Union" "Or" "Variant" - "Tuple" "And" "Record" - "Rec" - "Nominal" "->" "<-" - "All" "for_all" "for_any" "for_every" - "Ex" "there_exists" "for_some" - "Interface" - "type")) - (type//checking (altRE "is" "as" "let" "as_expected" "type_of" "sharing" "by_example" "hole")) - (type//dynamic (altRE "dynamic" "static")) - (type//capability (altRE "capability")) + (type//syntax (orRE "Union" "Or" "Variant" + "Tuple" "And" "Record" + "Rec" + "Nominal" "->" "<-" + "All" "for_all" "for_any" "for_every" + "Ex" "there_exists" "for_some" + "Interface" + "type")) + (type//checking (orRE "is" "as" "let" "as_expected" "type_of" "sharing" "by_example" "hole")) + (type//dynamic (orRE "dynamic" "static")) + (type//capability (orRE "capability")) ;; Data - (data//record (altRE "its" "has" "revised")) - (data//interface (altRE "use" "implementation" "with" "by")) - (data//implicit (altRE "implicitly" "a/an" "a" "an")) - (data//collection (altRE "list" "sequence" "tree")) + (data//record (orRE "its" "has" "revised")) + (data//interface (orRE "use" "implementation" "with" "by")) + (data//implicit (orRE "implicitly" "a/an" "a" "an")) + (data//collection (orRE "list" "sequence" "tree")) ;; Code - (code//quotation (altRE "`" "`'" "'" "," ",\\*" ",'")) - (code//super-quotation (altRE "``" ",,")) - (code//macro (altRE "macro")) + (code//quotation (orRE "`" "`'" "'" "," ",\\*" ",'")) + (code//super-quotation (orRE "``" ",,")) + (code//macro (orRE "macro")) ;; Miscellaneous - (alternative-format (altRE "character" "bin" "oct" "hex")) - (documentation (altRE "comment")) - (function-application (altRE "|>" "<|" "all")) - (function-definition (altRE "function" "|>>" "<<|" - "program")) - (remember (altRE "remember" "to_do" "fix_me")) - (extension (altRE "analysis" "synthesis" "translation" "declaration")) - (definition (altRE "\\.using" - "the" "every" - "alias"))) - (let ((control (altRE control//flow - control//pattern-matching - control//logic - control//contract - control//polymorphism)) - (type (altRE type//syntax - type//checking - type//dynamic - type//capability)) - (data (altRE data//record - data//interface - data//implicit - data//collection)) - (code (altRE code//quotation - code//super-quotation - code//macro))) + (alternative-format (orRE "character" "bin" "oct" "hex")) + (documentation (orRE "comment")) + (function-application (orRE "|>" "<|" "all")) + (function-definition (orRE "function" "|>>" "<<|" + "program")) + (remember (orRE "remember" "to_do" "fix_me")) + (extension (orRE "analysis" "synthesis" "translation" "declaration")) + (definition (orRE "\\.using" + "the" "every" + "alias"))) + (let ((control (orRE control//flow + control//pattern-matching + control//logic + control//contract + control//polymorphism)) + (type (orRE type//syntax + type//checking + type//dynamic + type//capability)) + (data (orRE data//record + data//interface + data//implicit + data//collection)) + (code (orRE code//quotation + code//super-quotation + code//macro))) (concat "(" - (altRE - control - type - data - code - ;; ;;;;;;;;;;;;;;;;;;;;;; - alternative-format - documentation - function-application - function-definition - remember - extension - definition - ;; ;;;;;;;;;;;;;;;;;;;;;; - "undefined" - "for" - "io" - "infix" - "message" - "regex") + (orRE control + type + data + code + ;; ;;;;;;;;;;;;;;;;;;;;;; + alternative-format + documentation + function-application + function-definition + remember + extension + definition + ;; ;;;;;;;;;;;;;;;;;;;;;; + "undefined" + "for" + "io" + "infix" + "message" + "regex") "\\>")))) (separator "\\.") (in-prelude separator) (in-current-module (concat separator separator)) (in-module (concat identifier separator)) ;; (in-local "") - (in-local (altRE "^" - (+class identifier_t))) - (global_prefix (altRE in-prelude - in-current-module - in-module - in-local)) + (in-local (orRE "^" + (+class identifier_t))) + (global_prefix (orRE in-prelude + in-current-module + in-module + in-local)) (typeRE (concat global_prefix (+class identifier_h|type) (-class identifier_t) "*")) (labelRE (concat global_prefix (+class identifier_h|label) (-class identifier_t) "+")) - (literalRE (altRE (literal binary_notation) ;; Bit literals - (literal natural) - (literal integer) - (literal revolution) - (literal decimal) - (literal fraction) - (literal rational) - ))) + (literalRE (orRE (literal binary_notation) ;; Bit literals + (literal natural) + (literal integer) + (literal revolution) + (literal decimal) + (literal fraction) + (literal rational) + ))) `(;; Special forms (,specialRE 1 font-lock-builtin-face) (,literalRE 0 font-lock-constant-face) @@ -513,7 +547,7 @@ highlighted region)." (font-lock-mark-block-function . mark-defun) (font-lock-syntactic-face-function . lux-font-lock-syntactic-face-function)))) -(defvar withRE (concat "\\`" "with" (altRE "_" "\\'"))) +(defvar withRE (concat "\\`" "with" (orRE "_" "\\'"))) (defun lux-indent-function (indent-point state) "When indenting a line within a function call, indent properly. diff --git a/stdlib/source/library/lux/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/compiler/language/lux/syntax.lux index fc048fd2d..b03bd19a3 100644 --- a/stdlib/source/library/lux/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/compiler/language/lux/syntax.lux @@ -30,11 +30,11 @@ (.using [library [lux (.except Alias - natural revolution) + natural revolution or) [abstract [monad (.only do)] ["<>" projection]] - [error + [error (.only error) ["[0]" try] ["[0]" exception (.only Exception)]] [data @@ -166,6 +166,9 @@ [(the .public ,name ,suffix)] ["b" suffix_of_binary] + ["o" suffix_of_octal] + ["d" suffix_of_decimal] + ["h" suffix_of_hexadecimal] ) (exception.the .public (end_of_file [module]) @@ -229,10 +232,14 @@ (Result it))) (expansion.let [,bit_false (these "0") - ,bit_true (these "1")] - (these (expansion.let [,every_digit_of_binary (these ,bit_false ,bit_true) - (these ,every_digit_of_binary "2" "3" "4" "5" "6" "7" "8" "9") - (template.with [] + ,bit_true (these "1") + + ,every_digit_of_binary (these ,bit_false ,bit_true) + ,every_digit_of_octal (these ,every_digit_of_binary "2" "3" "4" "5" "6" "7") + ,every_digit_of_decimal (these ,every_digit_of_octal "8" "9") + ,every_digit_of_hexadecimal (these ,every_digit_of_decimal "A" "B" "C" "D" "E" "F") + ,delimiter_of_digit (static ..digit_delimiter)] + (these (expansion.let [ (template.with [] [(,, (static ))] [text.space] @@ -241,36 +248,36 @@ [..open_form] [..close_form] [..open_variant] [..close_variant] [..open_tuple] [..close_tuple] - [..text_delimiter]) - (static ..digit_delimiter)] - (these (the !if_binary? - (template.macro (_ character then else) - [(.when_char# character - [[,every_digit_of_binary] - then] - - ... else - else)])) - - (the !if_digit? - (template.macro (_ character then else) - [(.when_char# character - [[] - then] - - ... else - else)])) - - (the !if_digit?+ - (template.macro (_ character then else_options else) - [(`` (.when_char# character - [[ ] - then - - (,, (template.spliced else_options))] + [..text_delimiter])] + (these (template.with [,single ,multiple ,every_digit] + [(the ,single + (template.macro (_ character then else) + [(.when_char# character + [,every_digit + then] - ... else - else))])) + ... else + else)])) + + (the ,multiple + (template.macro (_ character then else_options else) + [(`` (.when_char# character + [,every_digit + then + + [,delimiter_of_digit] + then + + (,, (template.spliced else_options))] + + ... else + else))]))] + + [!if_binary? !if_binary?+ [,every_digit_of_binary]] + [!if_octal? !if_octal?+ [,every_digit_of_octal]] + [!if_decimal? !if_decimal?+ [,every_digit_of_decimal]] + [!if_hexadecimal? !if_hexadecimal?+ [,every_digit_of_hexadecimal]] + ) (`` (the !if_name_character?|tail (template.macro (_ character then else) @@ -284,7 +291,7 @@ (`` (the !if_name_character?|head (template.macro (_ character then else) [(.when_char# character - [[ ] + [[ ,every_digit_of_decimal] else] ... else @@ -347,6 +354,24 @@ (..failure [,where @code] error))])) + (the value_with_suffix + (template.macro (_ the_globals ,where ) + [(when (|> @code + (!clip ) + (text.replaced ..digit_delimiter "") + (by of)) + {.#Right output} + (let [' (after )] + (..success [(let [[where::file where::line where::column] ,where] + [where::file where::line (!n/+ (!n/- ') where::column)]) + ' + @code] + output)) + + {.#Left error} + (..failure [,where @code] + error))])) + (the number (template.macro (_ the_globals ) [(when (|> @code @@ -436,15 +461,72 @@ [(!letE [source' full_name] (..full_name_projection the_globals aliases offset source) (..success source' {tag where full_name}))])) - (inlined (natural the_globals start where offset) - (-> types_of_the_globals Offset Provenance Offset - (Result Nat)) - (loop (next ['end offset]) - (<| (with_character the_globals 'end 'character (..value the_globals where start 'end n.base_10)) - (!if_digit?+ 'character + (the .public error_of_natural_is_not_valid + (error "error_of_natural_is_not_valid")) + + (the (natural_is_not_valid the_globals @) + (-> types_of_the_globals + (Projection Natural)) + (..failure @ ..error_of_natural_is_not_valid)) + + (template.with [,format ,name ,predicate ,suffix ,parent] + [(the (,name the_globals @) + (-> types_of_the_globals + (Projection Natural)) + (<| (let [[where start @code] @]) + (loop (next ['end start])) + (with_character the_globals 'end 'character (natural_is_not_valid the_globals @)) + (,predicate 'character + (next (after 'end)) + [] + (`` (.when_char# 'character + [[(,, (static ,suffix))] + (..value_with_suffix the_globals where start 'end ,format)] + + ... else + (,parent the_globals @))))))] + + [n.base_16 natural_in_hexadecimal !if_hexadecimal?+ ..suffix_of_hexadecimal + natural_is_not_valid] + [n.base_10 natural_in_decimal !if_decimal?+ ..suffix_of_decimal + natural_in_hexadecimal] + [n.base_08 natural_in_octal !if_octal?+ ..suffix_of_octal + natural_in_decimal] + ) + + (the (natural_in_default the_globals @) + (-> types_of_the_globals + (Projection Natural)) + (<| (let [[where start @code] @]) + (loop (next ['end start])) + (expansion.let [,else (..value the_globals where start 'end n.base_10)]) + (with_character the_globals 'end 'character ,else) + (!if_decimal?+ 'character (next (after 'end)) [] - (..value the_globals where start 'end n.base_10))))) + ,else))) + + (the (or left right) + (for_any (_ it) + (-> (-> types_of_the_globals + (Projection it)) + (-> types_of_the_globals + (Projection it)) + (-> types_of_the_globals + (Projection it)))) + (function (_ the_globals @) + (when (left the_globals @) + {.#Left error} + (right the_globals @) + + success + success))) + + (the natural + (-> types_of_the_globals + (Projection Natural)) + (or natural_in_octal + natural_in_default)) (the (decimal the_globals start where offset) (-> types_of_the_globals Offset Provenance Offset @@ -459,53 +541,54 @@ (loop (again [end offset exponent (static ..no_exponent)]) (<| (with_character the_globals end character/0 ) - (`` (`` (!if_digit?+ character/0 - (again (after end) exponent) - - [["e" "E"] - (if (same? (static ..no_exponent) exponent) - (<| (with_character the_globals (after end) character/1 ) - (`` (.when_char# character/1 - [[] - (<| (with_character the_globals (!n/+ 2 end) character/2 ) - (!if_digit?+ character/2 - (again (!n/+ 3 end) character/0) - [] - ))] - ... else - ))) - ) - - (,, (template.with [,unit] - [[(,, (static.text (its unit.#suffix ,unit)))] - (<| (!letE [[where' numerator_end _] numerator] (..value the_globals where start end decimal.base_10)) - (let [denominator (n.decimal (its unit.#factor ,unit))]) - (..success [where' (after numerator_end) @code] - {@type.#Decimal where (decimal./ denominator numerator)}))] - - [unit.degree] - [unit.gradian] - [unit.per_cent] - [unit.per_mille] - [unit.per_myriad] - )) - (,, (template.with [,unit] - [[(,, (static.text (its unit.#suffix ,unit)))] - (<| (!letE [[where' numerator_end _] numerator] (..value the_globals where start end decimal.base_10)) - (..success [where' (after numerator_end) @code] - {@type.#Decimal where (decimal.* (its unit.#factor ,unit) - numerator)}))] - - [unit.radian] - [unit.turn] - ))] - - ))))))) - - (inlined (rational the_globals numerator denominator_start where) - (-> types_of_the_globals Integer Offset Provenance - (Result @type.Code)) - (<| (!letE [[where' denominator_end _] denominator] (..natural the_globals denominator_start where denominator_start)) + (`` (`` (!if_decimal?+ character/0 + (again (after end) exponent) + + [["e" "E"] + (if (same? (static ..no_exponent) exponent) + (<| (with_character the_globals (after end) character/1 ) + (`` (.when_char# character/1 + [[] + (<| (with_character the_globals (!n/+ 2 end) character/2 ) + (!if_decimal?+ character/2 + (again (!n/+ 3 end) character/0) + [] + ))] + ... else + ))) + ) + + (,, (template.with [,unit] + [[(,, (static.text (its unit.#suffix ,unit)))] + (<| (!letE [[where' numerator_end _] numerator] (..value the_globals where start end decimal.base_10)) + (let [denominator (n.decimal (its unit.#factor ,unit))]) + (..success [where' (after numerator_end) @code] + {@type.#Decimal where (decimal./ denominator numerator)}))] + + [unit.degree] + [unit.gradian] + [unit.per_cent] + [unit.per_mille] + [unit.per_myriad] + )) + (,, (template.with [,unit] + [[(,, (static.text (its unit.#suffix ,unit)))] + (<| (!letE [[where' numerator_end _] numerator] (..value the_globals where start end decimal.base_10)) + (..success [where' (after numerator_end) @code] + {@type.#Decimal where (decimal.* (its unit.#factor ,unit) + numerator)}))] + + [unit.radian] + [unit.turn] + ))] + + ))))))) + + (the (rational numerator the_globals @) + (-> Integer types_of_the_globals + (Projection @type.Code)) + (<| (!letE [[where' denominator_end @code] denominator] (..natural the_globals @)) + (let [[where _] @]) (..success [where' denominator_end @code] (..as_rational where numerator denominator)))) @@ -515,30 +598,30 @@ (expansion.let [,success (..number the_globals start end integer.base_10 @type.#Integer)] (loop (again [end offset]) (<| (with_character the_globals end character ,success) - (`` (`` (!if_digit?+ character - (again (after end)) + (`` (`` (!if_decimal?+ character + (again (after end)) - [[(,, (static ..decimal_delimiter))] - (..decimal the_globals start where (after end)) + [[(,, (static ..decimal_delimiter))] + (..decimal the_globals start where (after end)) - [(,, (static rational.delimiter))] - (!letE [_ numerator] (..value the_globals where start end integer.base_10) - (..rational the_globals numerator (after end) where)) + [(,, (static rational.delimiter))] + (!letE [_ numerator] (..value the_globals where start end integer.base_10) + (..rational numerator the_globals [where (after end) @code])) - (,, (template.with [,unit] - [[(,, (static.text (its unit.#suffix ,unit)))] - (!letE [[where' numerator_end _] numerator] (..value the_globals where start end integer.base_10) - (..success [where' (after numerator_end) @code] - (..as_rational where numerator (its unit.#factor ,unit))))] + (,, (template.with [,unit] + [[(,, (static.text (its unit.#suffix ,unit)))] + (!letE [[where' numerator_end _] numerator] (..value the_globals where start end integer.base_10) + (..success [where' (after numerator_end) @code] + (..as_rational where numerator (its unit.#factor ,unit))))] - [unit.degree] - [unit.gradian] - [unit.per_cent] - [unit.per_mille] - [unit.per_myriad] - ))] + [unit.degree] + [unit.gradian] + [unit.per_cent] + [unit.per_mille] + [unit.per_myriad] + ))] - ,success))))))) + ,success))))))) (inlined (revolution the_globals start where offset) (-> types_of_the_globals Offset Provenance Offset @@ -546,27 +629,30 @@ (expansion.let [,success (..number the_globals start 'end revolution.base_10 @type.#Revolution)] (loop (next ['end offset]) (<| (with_character the_globals 'end 'character ,success) - (!if_digit?+ 'character - (next (after 'end)) - [] - ,success))))) - - (inlined (fraction the_globals numerator denominator_start where) - (-> types_of_the_globals Natural Offset Provenance - (Result @type.Code)) - (<| (!letE [[where' denominator_end _] denominator] (..natural the_globals denominator_start where denominator_start)) + (!if_decimal?+ 'character + (next (after 'end)) + [] + ,success))))) + + (the (fraction numerator the_globals @) + (-> Natural types_of_the_globals + (Projection @type.Code)) + (<| (!letE [[where' denominator_end @code] denominator] (..natural the_globals @)) + (let [[where _] @]) (..success [where' denominator_end @code] (..as_fraction where numerator denominator)))) - (inlined (positive the_globals start where offset) - (-> types_of_the_globals Offset Provenance Offset - (Result @type.Code)) - (<| (!letE [[where' numerator_end _] numerator] (..natural the_globals start where offset)) - (expansion.let [,natural (..number the_globals start numerator_end n.base_10 @type.#Natural)]) + (the (positive the_globals @) + (-> types_of_the_globals + (Projection @type.Code)) + (<| (let [[where start @code] @]) + (!letE [[where' numerator_end _] numerator] (..natural the_globals @)) + (expansion.let [,natural (..success [where' numerator_end @code] + {@type.#Natural where numerator})]) (with_character the_globals numerator_end potential_delimiter ,natural) (`` (`` (.when_char# potential_delimiter [[(,, (static fraction.delimiter))] - (..fraction the_globals numerator (after numerator_end) where') + (..fraction numerator the_globals [where' (after numerator_end) @code]) (,, (template.with [,unit] [[(,, (static.text (its unit.#suffix ,unit)))] @@ -588,9 +674,9 @@ (template.macro (_ the_globals offset where aliases end) [(<| (let ['offset/1 (after offset)]) (with_character the_globals 'offset/1 'character/1 end) - (!if_digit? 'character/1 - (signed_projection the_globals offset where (after/2 offset)) - (!full_name_projection the_globals offset [where (after offset) @code] where aliases @type.#Name)))])) + (!if_decimal? 'character/1 + (signed_projection the_globals offset where (after/2 offset)) + (!full_name_projection the_globals offset [where (after offset) @code] where aliases @type.#Name)))])) (the !horizontal (template.macro (_ the_globals where offset) @@ -690,14 +776,14 @@ {@type.#Bit where })] ... else - (..positive the_globals offset/0 where (after offset/0))))] + (..positive the_globals @)))] [,bit_false .false] [,bit_true .true]))] ... else - (..positive the_globals offset/0 where (after offset/0)))))) - + (..positive the_globals @))))) + (the .public (parse @code @module aliases) (-> Source_Code module.Name Aliases (Projection @type.Code)) @@ -746,24 +832,24 @@ (<| (let [offset/1 (after offset/0)]) (with_character the_globals offset/1 character/1 (!end_of_file the_globals where offset/1)) - (!if_digit? character/1 - ... It's a Revolution. - (..revolution the_globals offset/0 where (after offset/1)) - ... It's either a name, or a comment. - (.when_char# character/1 - [[(,, (static name.delimiter))] - ... It's either a name, or a comment. - (<| (let [offset/2 (after offset/1)]) - (with_character the_globals offset/2 character/2 - (!end_of_file the_globals where offset/2)) - (.when_char# character/2 - [[(,, (static name.delimiter))] - ... It's a comment. - ] - ... It's a name. - ))] - ... It's a name. - )))) + (!if_decimal? character/1 + ... It's a Revolution. + (..revolution the_globals offset/0 where (after offset/1)) + ... It's either a name, or a comment. + (.when_char# character/1 + [[(,, (static name.delimiter))] + ... It's either a name, or a comment. + (<| (let [offset/2 (after offset/1)]) + (with_character the_globals offset/2 character/2 + (!end_of_file the_globals where offset/2)) + (.when_char# character/2 + [[(,, (static name.delimiter))] + ... It's a comment. + ] + ... It's a name. + ))] + ... It's a name. + )))) [(,, (static ..positive_sign)) (,, (static ..negative_sign))] @@ -771,13 +857,13 @@ (!end_of_file the_globals where offset/0))] ... else - (!if_binary? character/0 - (..bit the_globals [where offset/0 @code]) - (!if_digit? character/0 - ... Natural number - (..positive the_globals offset/0 where (after offset/0)) - ... Name - (!full_name_projection the_globals offset/0 where aliases @type.#Name))) + (<| (!if_binary? character/0 + (..bit the_globals [where offset/0 @code])) + ... Natural number + (!if_decimal? character/0 + (..positive the_globals [where offset/0 @code])) + ... Name + (!full_name_projection the_globals offset/0 where aliases @type.#Name)) ))) ))))) ) diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index d2617a823..579790be1 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -497,87 +497,62 @@ _ ..silent_failure!))) -(the same - (Subsumption Type) - (function (_ partial complete it) - (let [[hypotheses super sub] it] - (if (for .php - ... TODO: Remove this once JPHP is gone. - false - (or (same? super sub) - (//.= super sub))) - (/#in hypotheses) - (<<| (exception.with ..does_not_subsume [super sub]) - (partial it)))))) - -(the variable - (Subsumption Type) - (function (_ partial complete it) - (let [[hypotheses super sub] it] - (when [super sub] - [{.#Variable idE} {.#Variable idA}] - (variable_on_variable complete [hypotheses idE idA]) - - [{.#Variable id} _] - (if_can_bind id sub - (/#in hypotheses) - (function (_ bound) - (complete [hypotheses bound sub]))) - - [_ {.#Variable id}] - (if_can_bind id super - (/#in hypotheses) - (function (_ bound) - (complete [hypotheses super bound]))) - - _ - (partial it))))) +(the when_variable + (template.macro (_ hypotheses complete) + [[{.#Variable idE} {.#Variable idA}] + (variable_on_variable complete [hypotheses idE idA]) + + [{.#Variable id} _] + (if_can_bind id sub + (/#in hypotheses) + (function (_ bound) + (complete [hypotheses bound sub]))) + + [_ {.#Variable id}] + (if_can_bind id super + (/#in hypotheses) + (function (_ bound) + (complete [hypotheses super bound])))])) (the !text#= (template.macro (_ super sub) [(.text_=# super sub)])) -(the opaque - (Subsumption Type) - (function (_ partial complete it) - (let [[hypotheses super sub] it] - (when [super sub] - [{.#Nominal e_name e_params} {.#Nominal a_name a_params}] - (if (and (!text#= e_name a_name) - (n.= (list.size e_params) (list.size a_params))) - (list.mix' ..monad - (function (_ [[expected_polarity e_head] - [actual_polarity a_head]] - hypotheses) - (if (bit.= expected_polarity actual_polarity) - (when expected_polarity - .co_variant - (complete [hypotheses e_head a_head]) - - .contra_variant - (complete [hypotheses a_head e_head])) - ..silent_failure!)) - hypotheses - (list.zipped_2 e_params a_params)) - ..silent_failure!) - - [{.#Opaque e!id} {.#Opaque a!id}] - (if (!n#= e!id a!id) - (/#in hypotheses) - ..silent_failure!) - - [{.#Named _ ?etype} _] - (complete [hypotheses ?etype sub]) - - [_ {.#Named _ ?atype}] - (complete [hypotheses super ?atype]) - - _ - (partial it))))) - -(the Complete_Subsumption - (.type (-> [(List Hypothesis) Type Type] - (Check (List Hypothesis))))) +(the when_nominal + (template.macro (_ hypotheses complete) + [[{.#Nominal e_name e_params} {.#Nominal a_name a_params}] + (if (and (!text#= e_name a_name) + (n.= (list.size e_params) (list.size a_params))) + (list.mix' ..monad + (function (_ [[expected_polarity e_head] + [actual_polarity a_head]] + hypotheses) + (if (bit.= expected_polarity actual_polarity) + (when expected_polarity + .co_variant + (complete [hypotheses e_head a_head]) + + .contra_variant + (complete [hypotheses a_head e_head])) + ..silent_failure!)) + hypotheses + (list.zipped_2 e_params a_params)) + ..silent_failure!)])) + +(the when_opaque + (template.macro (_ hypotheses complete) + [[{.#Opaque e!id} {.#Opaque a!id}] + (if (!n#= e!id a!id) + (/#in hypotheses) + ..silent_failure!)])) + +(the when_named + (template.macro (_ hypotheses complete) + [[{.#Named _ ?etype} sub] + (complete [hypotheses ?etype sub]) + + [super {.#Named _ ?atype}] + (complete [hypotheses super ?atype])])) (the limit (i64.left_shifted 7 1)) @@ -599,7 +574,7 @@ ["Hypotheses" (exception.listing ..hypothesis_as_text it)]))) (the (super_reification complete hypotheses super_parameter super_abstraction sub) - (-> Complete_Subsumption + (-> (Checker Type) (List Hypothesis) Type Type Type (Check (List Hypothesis))) (let [new_hypothesis [#super {.#Reification super_parameter super_abstraction} @@ -618,7 +593,7 @@ (the (opaque_reification complete hypotheses [super_quantification super_parameters] [sub_quantification sub_parameters]) - (-> Complete_Subsumption + (-> (Checker Type) (List Hypothesis) [Type (List Type)] [Type (List Type)] (Check (List Hypothesis))) @@ -633,96 +608,91 @@ (list.reversed (list.zipped_2 super_parameters sub_parameters))) ..silent_failure!))) -(the reification - (Subsumption Type) - (function (_ partial complete it) - (let [[hypotheses super sub] it] - (`` (when [super sub] - [{.#Reification super_parameter super_abstraction} - {.#Reification sub_parameter sub_abstraction}] - (let [super_application (//.flat_reification super) - sub_application (//.flat_reification sub)] - (when [(product.left super_application) (product.left sub_application)] - (^.or [{.#Opaque _} {.#Opaque _}] - [{.#Variable _} {.#Opaque _}] - [{.#Opaque _} {.#Variable _}]) - (opaque_reification complete hypotheses super_application sub_application) - - _ - (when [super_abstraction sub_abstraction] - (,, (template.with [ ] - [[ ] - (reification_on_reification complete - [hypotheses - [super_parameter ] - [sub_parameter ]])] - - [fE {.#Opaque ex}] - [{.#Opaque exE} fA] - - [fE {.#Variable idA}] - [{.#Variable idE} fA])) - - _ - (super_reification complete hypotheses super_parameter super_abstraction sub)))) - - [{.#Reification super_parameter super_abstraction} _] - (super_reification complete hypotheses super_parameter super_abstraction sub) - - [_ {.#Reification A F}] - (do ..monad - [sub' (..on (list A) F)] - (complete [hypotheses super sub'])) - - _ - (partial it)))))) - -(the quantification - (Subsumption Type) - (function (_ partial complete it) - (let [[hypotheses super sub] it] - (`` (when [super sub] - ... TODO: Refactor-away as cold-code - (,, (template.with [ ] - [[{.#Quantification _} _] - (do ..monad - [[_ paramT] - super' (..on (list paramT) super)] - (complete [hypotheses super' sub]))] - - [.universal ..existential] - [.existential ..var])) - - ... TODO: Refactor-away as cold-code - (,, (template.with [ ] - [[_ {.#Quantification _}] - (do ..monad - [[_ paramT] - sub' (..on (list paramT) sub)] - (complete [hypotheses super sub']))] - - [.universal ..var] - [.existential ..existential])) - - _ - (partial it)))))) +(`` (the when_reification + (template.macro (_ hypotheses complete) + [[{.#Reification super_parameter super_abstraction} + {.#Reification sub_parameter sub_abstraction}] + (let [super_application (//.flat_reification super) + sub_application (//.flat_reification sub)] + (when [(product.left super_application) (product.left sub_application)] + (^.or [{.#Opaque _} {.#Opaque _}] + [{.#Variable _} {.#Opaque _}] + [{.#Opaque _} {.#Variable _}]) + (opaque_reification complete hypotheses super_application sub_application) -(the else - (Subsumption Type) - (function (_ partial complete it) - ..silent_failure!)) + _ + (when [super_abstraction sub_abstraction] + (,, (template.with [ ] + [[ ] + (reification_on_reification complete + [hypotheses + [super_parameter ] + [sub_parameter ]])] + + [fE {.#Opaque ex}] + [{.#Opaque exE} fA] + + [fE {.#Variable idA}] + [{.#Variable idE} fA])) + + _ + (super_reification complete hypotheses super_parameter super_abstraction sub)))) + + [{.#Reification super_parameter super_abstraction} sub] + (super_reification complete hypotheses super_parameter super_abstraction sub) + + [super {.#Reification A F}] + (do ..monad + [sub' (..on (list A) F)] + (complete [hypotheses super sub']))]))) + +(`` (the when_quantification + (template.macro (_ hypotheses complete) + [... TODO: Refactor-away as cold-code + (,, (template.with [ ] + [[{.#Quantification _} _] + (do ..monad + [[_ paramT] + super' (..on (list paramT) super)] + (complete [hypotheses super' sub]))] + + [.universal ..existential] + [.existential ..var])) + + ... TODO: Refactor-away as cold-code + (,, (template.with [ ] + [[_ {.#Quantification _}] + (do ..monad + [[_ paramT] + sub' (..on (list paramT) sub)] + (complete [hypotheses super sub']))] + + [.universal ..var] + [.existential ..existential]))]))) (the subsumption (Checker Type) - (<| mixin.fixed - (all mixin.mixed - ..same - ..variable - ..opaque - ..reification - ..quantification - ..else - ))) + (function (complete it) + (let [[hypotheses super sub] it] + (if (for .php + ... TODO: Remove this once JPHP is gone. + false + (or (same? super sub) + (//.= super sub))) + (/#in hypotheses) + (<<| (exception.with ..does_not_subsume [super sub]) + ((`` (when [super sub] + (,, (when_variable hypotheses complete)) + + (,, (when_nominal hypotheses complete)) + (,, (when_opaque hypotheses complete)) + (,, (when_named hypotheses complete)) + + (,, (when_reification hypotheses complete)) + (,, (when_quantification hypotheses complete)) + + _ + ..silent_failure!)))))))) (the .public (check super sub) (-> Type Type diff --git a/stdlib/source/test/lux/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/compiler/language/lux/syntax.lux index 7d6562da9..7f9594070 100644 --- a/stdlib/source/test/lux/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/compiler/language/lux/syntax.lux @@ -210,6 +210,25 @@ [unit.radian] [unit.turn] )) + (,, (template.with [,suffix ,format] + [(_.coverage [,suffix] + (when (let [source_code (text "0" + (by ,format as natural_numerator) + ,suffix)] + (/.parse source_code "" (dictionary.empty text.hash) + [provenance.dummy 0 source_code])) + {.#Right [_ actual]} + (by code.equivalence = + (code.natural natural_numerator) + actual) + + else + false))] + + [/.suffix_of_octal n.base_08] + [/.suffix_of_decimal n.base_10] + [/.suffix_of_hexadecimal n.base_16] + )) )))) (the comment_text^