From cd71a864ad5be13ed6ec6d046e0a2cb1087bdf94 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 10 Sep 2021 01:21:23 -0400 Subject: Migrated variants to the new syntax. --- stdlib/source/documentation/lux.lux | 76 +++++++++++----------- .../lux/control/concurrency/actor.lux | 8 +-- stdlib/source/documentation/lux/control/maybe.lux | 2 +- stdlib/source/documentation/lux/control/try.lux | 4 +- .../documentation/lux/data/collection/array.lux | 2 +- stdlib/source/documentation/lux/ffi.jvm.lux | 4 +- stdlib/source/documentation/lux/ffi.old.lux | 4 +- 7 files changed, 50 insertions(+), 50 deletions(-) (limited to 'stdlib/source/documentation') diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index e81beecb2..0f6e94998 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -329,17 +329,17 @@ (type: Type (Rec @ (Variant - (#Primitive Text (List @)) - (#Sum @ @) - (#Product @ @) - (#Function @ @) - (#Parameter Nat) - (#Var Nat) - (#Ex Nat) - (#UnivQ (List @) @) - (#ExQ (List @) @) - (#Apply @ @) - (#Named Name @))))]) + {#Primitive Text (List @)} + {#Sum @ @} + {#Product @ @} + {#Function @ @} + {#Parameter Nat} + {#Var Nat} + {#Ex Nat} + {#UnivQ (List @) @} + {#ExQ (List @) @} + {#Apply @ @} + {#Named Name @})))]) (documentation: /.exec "Sequential execution of expressions (great for side-effects)." @@ -354,8 +354,8 @@ \n "Allows the usage of macros within the patterns to provide custom syntax.") [(case (: (List Int) (list +1 +2 +3)) - (#Item x (#Item y (#Item z #End))) - (#Some ($_ * x y z)) + {#Item x {#Item y {#Item z #End}}} + {#Some ($_ * x y z)} _ #None)]) @@ -366,7 +366,7 @@ [(case (: (List Int) (list +1 +2 +3)) (^ (list x y z)) - (#Some ($_ * x y z)) + {#Some ($_ * x y z)} _ #None)]) @@ -435,7 +435,7 @@ [(macro: .public (name_of tokens) (case tokens (^template [] - [(^ (list [_ ( [module name])])) + [(^ (list [_ { [module name]}])) (in (list (` [(~ (text$ module)) (~ (text$ name))])))]) ([#Identifier] [#Tag]) @@ -489,8 +489,8 @@ [(type: Referrals (Variant #All - (#Only (List Text)) - (#Exclude (List Text)) + {#Only (List Text)} + {#Exclude (List Text)} #Ignore #Nothing))]) @@ -506,7 +506,7 @@ "The type-definition macro." [(type: (List a) #End - (#Item a (List a)))]) + {#Item a (List a)})]) (documentation: /.Interface "Interface definition." @@ -540,13 +540,13 @@ (loop [end to output #.End] (cond (< end from) - (recur (pred end) (#.Item end output)) + (recur (pred end) {#.Item end output}) (< from end) - (recur (succ end) (#.Item end output)) + (recur (succ end) {#.Item end output}) ... (= end from) - (#.Item end output)))))]) + {#.Item end output}))))]) (documentation: /.cond "Conditional branching with multiple test conditions." @@ -640,30 +640,30 @@ [(def: (reduced env type) (-> (List Type) Type Type) (case type - (#.Primitive name params) - (#.Primitive name (list\each (reduced env) params)) + {#.Primitive name params} + {#.Primitive name (list\each (reduced env) params)} (^template [] - [( left right) - ( (reduced env left) (reduced env right))]) + [{ left right} + { (reduced env left) (reduced env right)}]) ([#.Sum] [#.Product]) (^template [] - [( left right) - ( (reduced env left) (reduced env right))]) + [{ left right} + { (reduced env left) (reduced env right)}]) ([#.Function] [#.Apply]) (^template [] - [( old_env def) + [{ old_env def} (case old_env #.End - ( env def) + { env def} _ type)]) ([#.UnivQ] [#.ExQ]) - (#.Parameter idx) + {#.Parameter idx} (else type (list.item idx env)) _ @@ -751,21 +751,21 @@ (format "Multi-level pattern matching." \n "Useful in situations where the result of a branch depends on further refinements on the values being matched.") [(case (split (size static) uri) - (^multi (#Some [chunk uri']) + (^multi {#Some [chunk uri']} [(text\= static chunk) #1]) (match_uri endpoint? parts' uri') _ - (#Left (format "Static part " (%t static) " does not match URI: " uri)))] + {#Left (format "Static part " (%t static) " does not match URI: " uri)})] ["Short-cuts can be taken when using bit tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#Some [chunk uri']) + (^multi {#Some [chunk uri']} (text\= static chunk)) (match_uri endpoint? parts' uri') _ - (#Left (format "Static part " (%t static) " does not match URI: " uri)))]) + {#Left (format "Static part " (%t static) " does not match URI: " uri)})]) (documentation: /.name_of "Given an identifier or a tag, gives back a 2 tuple with the module and name parts, both as Text." @@ -875,8 +875,8 @@ "Generates pattern-matching code for Code values in a way that looks like code-templating." [(: (Maybe Nat) (case (` (#0 123 +456.789)) - (^code (#0 (~ [_ (#.Nat number)]) +456.789)) - (#.Some number) + (^code (#0 (~ [_ {#.Nat number}]) +456.789)) + {#.Some number} _ #.None))]) @@ -898,11 +898,11 @@ (case (: (Either Text Bar) (try (: Bar (risky computation which may panic)))) - (#.Right success) + {#.Right success} (: Foo (do something after success)) - (#.Left error) + {#.Left error} (: Foo (recover from error))))]) diff --git a/stdlib/source/documentation/lux/control/concurrency/actor.lux b/stdlib/source/documentation/lux/control/concurrency/actor.lux index c0701a367..a26d2f2d6 100644 --- a/stdlib/source/documentation/lux/control/concurrency/actor.lux +++ b/stdlib/source/documentation/lux/control/concurrency/actor.lux @@ -58,8 +58,8 @@ (message: .public (push [value a] state self) (List a) - (let [state' (#.Item value state)] - (async.resolved (#try.Success [state' state']))))]) + (let [state' {#.Item value state}] + (async.resolved {#try.Success [state' state']})))]) (actor: .public counter Nat @@ -67,11 +67,11 @@ [(message: .public (count! [increment Nat] state self) Any (let [state' (n.+ increment state)] - (async.resolved (#try.Success [state' state'])))) + (async.resolved {#try.Success [state' state']}))) (message: .public (read! state self) Nat - (async.resolved (#try.Success [state state])))]))] + (async.resolved {#try.Success [state state]}))]))] (documentation: /.actor: (format "Defines a named actor, with its behavior and internal state." \n "Messages for the actor must be defined after the on_mail handler.") diff --git a/stdlib/source/documentation/lux/control/maybe.lux b/stdlib/source/documentation/lux/control/maybe.lux index f57f2f54d..582c1fa4a 100644 --- a/stdlib/source/documentation/lux/control/maybe.lux +++ b/stdlib/source/documentation/lux/control/maybe.lux @@ -18,7 +18,7 @@ (format "Allows you to provide a default value that will be used" \n "if a (Maybe x) value turns out to be #.None." \n "Note: the expression for the default value will not be computed if the base computation succeeds.") - [(else +20 (#.Some +10)) + [(else +20 {#.Some +10}) "=>" +10] [(else +20 #.None) diff --git a/stdlib/source/documentation/lux/control/try.lux b/stdlib/source/documentation/lux/control/try.lux index 6ef45a5b2..8176614d0 100644 --- a/stdlib/source/documentation/lux/control/try.lux +++ b/stdlib/source/documentation/lux/control/try.lux @@ -40,9 +40,9 @@ \n "if a (Try x) value turns out to be #Failure." \n "Note: the expression for the default value will not be computed if the base computation succeeds.") [(= "bar" - (else "foo" (#..Success "bar")))] + (else "foo" {#..Success "bar"}))] [(= "foo" - (else "foo" (#..Failure "KABOOM!")))]) + (else "foo" {#..Failure "KABOOM!"}))]) (.def: .public documentation (.List $.Module) diff --git a/stdlib/source/documentation/lux/data/collection/array.lux b/stdlib/source/documentation/lux/data/collection/array.lux index ed6bce3a5..b8926391a 100644 --- a/stdlib/source/documentation/lux/data/collection/array.lux +++ b/stdlib/source/documentation/lux/data/collection/array.lux @@ -87,7 +87,7 @@ (format "Yields a list with every non-empty item in the array." \n "Can use the optional default value when encountering an empty cell in the array.") [(list #.None array) - (list (#.Some default) array)]) + (list {#.Some default} array)]) (.def: .public documentation (.List $.Module) diff --git a/stdlib/source/documentation/lux/ffi.jvm.lux b/stdlib/source/documentation/lux/ffi.jvm.lux index f76ada558..d8e818783 100644 --- a/stdlib/source/documentation/lux/ffi.jvm.lux +++ b/stdlib/source/documentation/lux/ffi.jvm.lux @@ -144,7 +144,7 @@ [(= (??? (: java/lang/String (null))) #.None)] [(= (??? "YOLO") - (#.Some "YOLO"))]) + {#.Some "YOLO"})]) (documentation: /.!!! (format "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -158,7 +158,7 @@ (format "Checks whether an object is an instance of a particular class." \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.") [(case (check String "YOLO") - (#.Some value_as_string) + {#.Some value_as_string} #.None)]) (documentation: /.synchronized diff --git a/stdlib/source/documentation/lux/ffi.old.lux b/stdlib/source/documentation/lux/ffi.old.lux index b2ac15139..64fbfcf45 100644 --- a/stdlib/source/documentation/lux/ffi.old.lux +++ b/stdlib/source/documentation/lux/ffi.old.lux @@ -107,7 +107,7 @@ [(= (??? (: java/lang/String (null))) #.None)] [(= (??? "YOLO") - (#.Some "YOLO"))]) + {#.Some "YOLO"})]) (documentation: /.!!! "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -121,7 +121,7 @@ (format "Checks whether an object is an instance of a particular class." \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.") [(case (check java/lang/String "YOLO") - (#.Some value_as_string) + {#.Some value_as_string} #.None)]) (documentation: /.synchronized -- cgit v1.2.3