diff --git a/data/entities.yaml b/data/entities.yaml index 512792e2..dee3cc71 100644 --- a/data/entities.yaml +++ b/data/entities.yaml @@ -339,7 +339,7 @@ - | An equipped `linotype`{=entity} device enables the `format` command: ``` - format : a -> text + format : a -> Text ``` which can turn any value into a suitable text representation. properties: [pickable] @@ -353,8 +353,8 @@ - | Facilitates the concatenation of text values. - | - The infix operator `++ : text -> text -> text`{=snippet} - can be used to concatenate two text values. For example, + The infix operator `++ : Text -> Text -> Text`{=snippet} + can be used to concatenate two `Text`{=type} values. For example, - | ``` let numWidgets = 42 @@ -370,9 +370,9 @@ - Simple, yet accurate measuring device. Can determine the length of a text value. - | ``` - chars : text -> int + chars : Text -> Int ``` - computes the number of characters in a `text`{=type} value. + computes the number of characters in a `Text`{=type} value. properties: [pickable] capabilities: [charcount] - name: wedge @@ -384,9 +384,9 @@ - | An equipped `wedge`{=entity} enables the `split` command: ``` - split : int -> text -> text * text + split : Int -> Text -> Text * Text ``` - splits a `text`{=type} value into two pieces, one before the given index and one after. + splits a `Text`{=type} value into two pieces, one before the given index and one after. properties: [pickable] capabilities: [split] - name: string @@ -397,12 +397,12 @@ - A long, flexible device for transferring either force or information, made of twisted cotton fibers. Multiple strings can also be woven into larger configurations such as cloth or nets. - | An equipped `string`{=entity} device enables several commands for working with - `text`{=type} values: + `Text`{=type} values: - | - `format : a -> text` can turn any value into a suitable text + `format : a -> Text` can turn any value into a suitable text representation. - | - The infix operator `++ : text -> text -> text`{=snippet} + The infix operator `++ : Text -> Text -> Text`{=snippet} can be used to concatenate two text values. For example, - | ``` @@ -410,10 +410,10 @@ in "Number of widgets: " ++ format numWidgets ``` - | - `chars : text -> int` computes the number of characters in a - `text`{=type} value. + `chars : Text -> Int` computes the number of characters in a + `Text`{=type} value. - | - `split : int -> text -> text * text` splits a `text`{=type} value into + `split : Int -> Text -> Text * Text` splits a `Text`{=type} value into two pieces, one before the given index and one after. properties: [pickable] capabilities: [format, concat, charcount, split] @@ -427,10 +427,10 @@ back, shaped for some reason into a ring. When equipped, it enables two functions: - | - `charAt : int -> text -> int` returns the numeric code of the - character at a specific index in a (0-indexed) `text`{=type} value. + `charAt : Int -> Text -> Int` returns the numeric code of the + character at a specific index in a (0-indexed) `Text`{=type} value. - | - `toChar : int -> text` creates a singleton (length-1) `text`{=type} + `toChar : Int -> Text` creates a singleton (length-1) `Text`{=type} value containing a character with the given numeric code. properties: [pickable] capabilities: [code] @@ -443,7 +443,7 @@ - Lambdas can also be used to create functions. For example, - | ``` - def thrice : cmd unit -> cmd unit = \c. c;c;c end + def thrice : Cmd Unit -> Cmd Unit = \c. c;c;c end ``` - defines the function `thrice`{=snippet} which repeats a command three times. properties: [pickable, growable] @@ -575,10 +575,10 @@ description: - This enables the `structure` and `floorplan` commands to locate and analyze structures placed in the world. - | - `structure : text -> int -> cmd (unit + (int * (int * int)))` + `structure : Text -> Int -> Cmd (Unit + (Int * (Int * Int)))` - Gets the x, y coordinates of the southwest corner of a constructed structure, by name and index. - | - `floorplan : text -> cmd (int * int)` + `floorplan : Text -> Cmd (Int * Int)` - Gets the dimensions of a structure template. properties: [pickable] capabilities: [structure] @@ -753,7 +753,7 @@ description: - A broad, sturdy surface that can be attached to a robot and used to `push` objects. - | - `push : cmd unit` will advance the robot and the entity in front of it forward by one step. + `push : Cmd Unit` will advance the robot and the entity in front of it forward by one step. properties: [pickable] capabilities: [push] - name: grabber @@ -764,7 +764,7 @@ - A grabber arm is an all-purpose, hydraulically controlled device that can manipulate other items and robots via the `grab`, `place`, and `give` commands. - The `grab` command takes no arguments; it simply grabs whatever is available, and also returns the name of the grabbed thing as a string. It raises an exception if run in a cell that does not contain an item. - The `place` command takes one argument, the name of the item to place. The item is removed from the robot's inventory and placed in the robot's current cell (which must be empty). Raises an exception if the operation fails. - - "The `give` command takes two arguments: the actor to give an item to (which can be at most 1 cell away), and the name of the item to give. Raises an exception if the operation fails." + - "The `give` command takes two arguments: the `Actor`{=type} to give an item to (which can be at most 1 cell away), and the name of the item to give. Raises an exception if the operation fails." capabilities: [grab, give, place] properties: [pickable] - name: fast grabber @@ -888,11 +888,11 @@ expression or command locally within another expression. - | ``` - def m2 : cmd unit = move; move end + def m2 : Cmd Unit = move; move end ``` - | ``` - let x : int = 3 in x^2 + 2*x + 1 + let x : Int = 3 in x^2 + 2*x + 1 ``` - The type annotations in `def`{=snippet} are optional. properties: [pickable] @@ -936,7 +936,7 @@ char: '$' description: - "With a scanner device, robots can use the `scan` command to learn about their surroundings. Simply give `scan` a direction in which to scan, and information about the scanned item (if any) will be added to the robot's inventory." - - "A scanner also enables `blocked : cmd bool`, which returns a boolean value indicating whether the robot's path is blocked (i.e. whether executing a `move` command would fail); `ishere : text -> cmd bool` for checking whether the current cell contains a particular entity; and `isempty : cmd bool` for checking whether the current cell is empty of entities. Note that `ishere` and `isempty` do not detect robots, only entities." + - "A scanner also enables `blocked : Cmd Bool`, which returns a boolean value indicating whether the robot's path is blocked (i.e. whether executing a `move` command would fail); `ishere : Text -> Cmd Bool` for checking whether the current cell contains a particular entity; and `isempty : Cmd Bool` for checking whether the current cell is empty of entities. Note that `ishere` and `isempty` do not detect robots, only entities." - "Finally, robots can use the `upload` command to copy their accumulated knowledge to another nearby robot; for example, `upload base`." properties: [pickable] capabilities: [scan, sensefront, sensehere] @@ -946,7 +946,7 @@ description: - An electronic "nose" that can tell how far away something is. - | - `sniff : text -> cmd int` returns the distance to the nearest specified entity. + `sniff : Text -> Cmd Int` returns the distance to the nearest specified entity. properties: [pickable] capabilities: [detectdistance] - name: flash memory @@ -998,10 +998,10 @@ char: 'C' description: - | - A counter enables the command `count : text -> cmd int`, + A counter enables the command `count : Text -> Cmd Int`, which counts how many occurrences of an entity are currently in the inventory. This is an upgraded version of the `has` - command, which returns a bool instead of an int and does + command, which returns a `Bool`{=type} instead of an `Int`{=type} and does not require any special device. properties: [pickable] capabilities: [count] @@ -1024,20 +1024,20 @@ addition to the usual arithmetic on numbers, an ADT calculator can also do arithmetic on types! After all, the helpful typewritten manual explains, a type is just a collection of values, and a finite collection - of values is just a fancy number. For example, the type `bool`{=type} is + of values is just a fancy number. For example, the type `Bool`{=type} is just a fancy version of the number 2, where the two things happen to be - labelled `false` and `true`. There are also types `unit`{=type} and + labelled `false` and `true`. There are also types `Unit`{=type} and `void`{=type} that correspond to 1 and 0, respectively. - | The product of two types is a type of pairs, since, for example, if `t`{=type} is a type with three elements, then there are 2 * 3 = 6 - different pairs containing a `bool`{=type} and a `t`{=type}, that is, 6 elements - of type `bool * t`{=type}. For working with products of types, the ADT + different pairs containing a `Bool`{=type} and a `t`{=type}, that is, 6 elements + of type `Bool * t`{=type}. For working with products of types, the ADT calculator enables pair syntax `(1, "Hi!")` as well as the projection functions `fst : a * b -> a` and `snd : a * b -> b`. - | The sum of two types is a type with two options; for example, a - value of type `bool + t`{=type} is either a `bool`{=type} value or a `t`{=type} value, + value of type `Bool + t`{=type} is either a `Bool`{=type} value or a `t`{=type} value, and there are `2 + 3 == 5` such values. For working with sums of types, the ADT calculator provides the injection functions `inl : a -> a + b` and `inr : b -> a + b`, as well as the case analysis @@ -1057,7 +1057,7 @@ - | `turn west; move; turn north` - | - It also enables the `heading : cmd dir` command, which returns the + It also enables the `heading : Cmd Dir` command, which returns the robot's current heading. For example, the following code moves east and then restores the same heading as before: - | @@ -1071,9 +1071,9 @@ description: - A clock is a device for keeping track of time. It enables the `wait` and `time` commands. - | - `time : cmd int` returns the current time, measured in game ticks since the beginning of the game. + `time : Cmd Int` returns the current time, measured in game ticks since the beginning of the game. - | - `wait : int -> cmd unit` causes a robot to sleep for a specified amount of time (measured in game ticks). + `wait : Int -> Cmd Unit` causes a robot to sleep for a specified amount of time (measured in game ticks). properties: [pickable] capabilities: [timeabs, timerel] - name: hourglass @@ -1083,7 +1083,7 @@ description: - An hourglass can measure the relative passage of time. It enables the `wait` command. - | - `wait : int -> cmd unit` causes a robot to sleep for a specified amount of time (measured in game ticks). + `wait : Int -> Cmd Unit` causes a robot to sleep for a specified amount of time (measured in game ticks). properties: [pickable] capabilities: [timerel] - name: rolex @@ -1093,7 +1093,7 @@ description: - Enables robots to use the `watch` and `wait` commands. - | - `watch : dir -> cmd unit` will mark an adjacent (in the specified direction) location of interest to monitor for placement or removal of items. + `watch : Dir -> Cmd Unit` will mark an adjacent (in the specified direction) location of interest to monitor for placement or removal of items. A subsequent call to `wait` will be interrupted upon a change to the location. properties: [pickable] capabilities: [timerel, wakeself] @@ -1156,12 +1156,12 @@ waves off them and listening for the echo. This capability can be accessed via two commands: - | - `meet : cmd (unit + actor)` tries to locate a + `meet : Cmd (Unit + Actor)` tries to locate a nearby actor (a robot, or... something else?) up to one cell away. It returns a reference to the nearest actor, or a unit value if none are found. - | - `meetAll : (b -> actor -> cmd b) -> b -> cmd b` runs a command on + `meetAll : (b -> Actor -> Cmd b) -> b -> Cmd b` runs a command on every nearby actor (other than oneself), folding over the results to compute a final result of type `b`{=type}. For example, if `x`{=snippet}, `y`{=snippet}, and `z`{=snippet} @@ -1177,7 +1177,7 @@ - | A GPS receiver triangulates your current (x,y) coordinates from some convenient satellite signals, - enabling the command `whereami : cmd (int * int)`. + enabling the command `whereami : Cmd (Int * Int)`. properties: [pickable] capabilities: [senseloc] - name: tweezers @@ -1205,7 +1205,7 @@ - | Also allows manipulating composite values consisting of a collection of named fields. For example, `[x = 2, y = "hi"]` - is a value of type `[x : int, y : text]`{=type}. Individual fields + is a value of type `[x : Int, y : Text]`{=type}. Individual fields can be projected using dot notation. For example, `let r = [y="hi", x=2] in r.x` has the value `2`. The order of the fields does not matter. @@ -1234,11 +1234,11 @@ description: - A small device with multiple keys, adapted for your unique anatomy. - | - `installKeyHandler : text -> (key -> cmd unit) -> cmd unit` + `installKeyHandler : Text -> (Key -> Cmd Unit) -> Cmd Unit` installs a custom handler function that can be activated to respond to keyboard inputs typed at the REPL. - | - `key : text -> key` constructs values of type `key`{=type}, for + `key : Text -> Key` constructs values of type `Key`{=type}, for example `key "Down"` or `key "C-S-x"`. properties: [pickable] capabilities: [handleinput] @@ -1249,7 +1249,7 @@ description: - A device to solve the halting problem. When asked if a particular robot program will halt, it always answers YES. And it is always correct... or else! - | - Enables the command `halt : actor -> cmd unit` which takes + Enables the command `halt : Actor -> Cmd Unit` which takes a robot as an argument and, if it is up to one cell away, cancels its currently running program (if any). In creative mode, there is no distance limitation. @@ -1269,7 +1269,7 @@ description: - | Enables the `teleport` command, which takes as arguments an - `actor`{=type} and a location in the form of a pair of + `Actor`{=type} and a location in the form of a pair of coordinates, and teleports the given actor to the specified coordinates (and may also have some improbable side effects). properties: [pickable] diff --git a/data/scenarios/Challenges/2048.yaml b/data/scenarios/Challenges/2048.yaml index 887d6fce..bc1de201 100644 --- a/data/scenarios/Challenges/2048.yaml +++ b/data/scenarios/Challenges/2048.yaml @@ -11,7 +11,7 @@ objectives: as base {has "2048"} } { return false } solution: | - def makeN : int -> cmd unit = \n. + def makeN : Int -> Cmd Unit = \n. if (n == 1) {harvest; return ()} {makeN (n/2); makeN (n/2); make (format n)} diff --git a/data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw b/data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw index f8d3328e..59caab37 100644 --- a/data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw +++ b/data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw @@ -1,7 +1,7 @@ // Spawns worker bees when structures are detected def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; -def mod : int -> int -> int = \a. \b. a - (a/b)*b end; +def mod : Int -> Int -> Int = \a. \b. a - (a/b)*b end; def abs = \n. if (n < 0) {-n} {n} end; def min = \x. \y. if (x < y) {x} {y} end; diff --git a/data/scenarios/Challenges/Ranching/_gated-paddock/fence-construction.sw b/data/scenarios/Challenges/Ranching/_gated-paddock/fence-construction.sw index a4c88b19..3f5f387f 100644 --- a/data/scenarios/Challenges/Ranching/_gated-paddock/fence-construction.sw +++ b/data/scenarios/Challenges/Ranching/_gated-paddock/fence-construction.sw @@ -202,7 +202,7 @@ def collectWool = turn back; - let forever : cmd unit -> cmd unit = \c. c ; forever c in + let forever : Cmd Unit -> Cmd Unit = \c. c ; forever c in forever sweepAreaForWool; end; diff --git a/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw b/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw index 98ebed22..a1d64aa9 100644 --- a/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw +++ b/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw @@ -36,7 +36,7 @@ def turnCloverDirection = def decideDirection = - let randdir : cmd dir = + let randdir : Cmd Dir = d <- random 4; return $ if (d == 0) { north @@ -62,8 +62,8 @@ def decideDirection = } end; -let forever : cmd unit -> cmd unit = \c. c ; forever c in -let repeat : int -> cmd unit -> cmd unit = +let forever : Cmd Unit -> Cmd Unit = \c. c ; forever c in +let repeat : Int -> Cmd Unit -> Cmd Unit = \n. \c. if (n == 0) {} {c ; repeat (n-1) c} in diff --git a/data/scenarios/Challenges/Ranching/_powerset/setup.sw b/data/scenarios/Challenges/Ranching/_powerset/setup.sw index d9d712c2..09963742 100644 --- a/data/scenarios/Challenges/Ranching/_powerset/setup.sw +++ b/data/scenarios/Challenges/Ranching/_powerset/setup.sw @@ -2,7 +2,7 @@ def elif = \t. \then. \else. {if t then else} end def else = \t. t end // modulus function (%) -def mod : int -> int -> int = \i. \m. +def mod : Int -> Int -> Int = \i. \m. i - m * (i / m) end @@ -218,7 +218,7 @@ def setup = \inputCardinality. /** One-based ordinal of the item. */ -def getOrdinal : text -> cmd int = \item. +def getOrdinal : Text -> Cmd Int = \item. count item; end; diff --git a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/maintainer.sw b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/maintainer.sw index db5ff07f..ba3cbf0e 100644 --- a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/maintainer.sw +++ b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/maintainer.sw @@ -11,7 +11,7 @@ def computeTriangularNumber = \n. (n * (n + 1)) / 2 end; -def mod : int -> int -> int = \i.\m. +def mod : Int -> Int -> Int = \i.\m. i - m * (i / m); end @@ -46,7 +46,7 @@ def teleportToDetectResult = \referenceLoc. \relativeLoc. teleport self newLoc; end; -def getOrdinal : text -> cmd int = \item. +def getOrdinal : Text -> Cmd Int = \item. count $ item ++ "-ordinal"; end; @@ -166,7 +166,7 @@ def handleMarker = \boardWidth. \boardHeight. Precondition: Facing east at location (0, 0). */ -def iterateAllTiles : cmd unit -> cmd unit = \func. +def iterateAllTiles : Cmd Unit -> Cmd Unit = \func. let b = "border" in isOnBottomBorder <- itemIsHere b; if isOnBottomBorder {} { diff --git a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/setup.sw b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/setup.sw index 41d113fc..9d5ae6a0 100644 --- a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/setup.sw +++ b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/setup.sw @@ -8,7 +8,7 @@ def else = id end def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; -def mod : int -> int -> int = \i.\m. +def mod : Int -> Int -> Int = \i.\m. i - m * (i / m) end @@ -23,7 +23,7 @@ def getLetterEntityByIndex = \idx. letter ++ "-tile"; end; -def getOrdinal : text -> cmd int = \item. +def getOrdinal : Text -> Cmd Int = \item. count $ item ++ "-ordinal"; end; @@ -112,7 +112,7 @@ def countInversions = \n. \i. Left is a Boolean indicating whether the tile has been drilled. Right is a valid tile entity name. */ -def scanValid : dir -> cmd (bool + text) = \d. +def scanValid : Dir -> Cmd (Bool + Text) = \d. maybeTileForward <- scan d; case maybeTileForward (\_. return $ inL false) diff --git a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/solution.sw b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/solution.sw index 5990dcdb..89755bcd 100644 --- a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/solution.sw +++ b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/solution.sw @@ -21,7 +21,7 @@ def signum = \x. $ else {0}; end; -def mod : int -> int -> int = \i.\m. +def mod : Int -> Int -> Int = \i.\m. i - m * (i / m); end @@ -35,7 +35,7 @@ def sumTuples = \t1. \t2. (fst t1 + fst t2, snd t1 + snd t2); end; -def getOrdinal : text -> cmd int = \item. +def getOrdinal : Text -> Cmd Int = \item. count $ item ++ "-ordinal"; end; @@ -60,7 +60,7 @@ def getRelativeLocation = \absLoc. return $ sumTuples negatedLoc absLoc; end; -def getRelativeRectangle : (int * int) * (int * int) -> cmd ((int * int) * (int * int)) = \corners. +def getRelativeRectangle : (Int * Int) * (Int * Int) -> Cmd ((Int * Int) * (Int * Int)) = \corners. myloc <- whereami; let negatedLoc = negateTuple myloc in return $ mapTuple (sumTuples negatedLoc) corners; diff --git a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/validate-board.sw b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/validate-board.sw index 3a2d99ae..239081be 100644 --- a/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/validate-board.sw +++ b/data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/validate-board.sw @@ -7,7 +7,7 @@ def itemIsHere = \item. case x (\_. return false) (\found. return $ found == item); end; -def getOrdinal : text -> cmd int = \item. +def getOrdinal : Text -> Cmd Int = \item. count $ item ++ "-ordinal"; end; @@ -16,7 +16,7 @@ def getOrdinal : text -> cmd int = \item. Returns a Left if we are non-monotonic. Otherwise returns the next expected value. */ -def isMonotonic : int -> cmd (unit + int) = \expectedVal. +def isMonotonic : Int -> Cmd (Unit + Int) = \expectedVal. maybeItem <- scan down; case maybeItem (\_. return $ inR expectedVal) // Cell was blank @@ -38,7 +38,7 @@ def isMonotonic : int -> cmd (unit + int) = \expectedVal. Precondition: Facing east at location (0, 0). */ -def loopMonotonicityCheck : int -> cmd bool = \expectedVal. +def loopMonotonicityCheck : Int -> Cmd Bool = \expectedVal. isOnBottomBorder <- itemIsHere "border"; if isOnBottomBorder { return true; diff --git a/data/scenarios/Challenges/_blender/apprehension-checker.sw b/data/scenarios/Challenges/_blender/apprehension-checker.sw index a98e7124..3dad7aa4 100644 --- a/data/scenarios/Challenges/_blender/apprehension-checker.sw +++ b/data/scenarios/Challenges/_blender/apprehension-checker.sw @@ -18,7 +18,7 @@ encountering an invalid robot index. Distinguishes system bots from the base by name. Returns true if a bot has "met" the base. */ -def anyHasMetBase : int -> cmd bool = \idx. +def anyHasMetBase : Int -> Cmd Bool = \idx. try { bot <- robotnumbered idx; diff --git a/data/scenarios/Challenges/_friend/cat.sw b/data/scenarios/Challenges/_friend/cat.sw index f700408a..52cf4796 100644 --- a/data/scenarios/Challenges/_friend/cat.sw +++ b/data/scenarios/Challenges/_friend/cat.sw @@ -1,6 +1,6 @@ -def forever : cmd unit -> cmd unit = \c. c ; forever c end +def forever : Cmd Unit -> Cmd Unit = \c. c ; forever c end -def repeat : int -> cmd unit -> cmd unit = +def repeat : Int -> Cmd Unit -> Cmd Unit = \n. \c. if (n == 0) {} {c ; repeat (n-1) c} end @@ -9,7 +9,7 @@ def else = \t. t end def abs = \n. if (n < 0) {-n} {n} end -def randdir : cmd dir = +def randdir : Cmd Dir = d <- random 4; return ( if (d == 0) {north} @@ -19,7 +19,7 @@ def randdir : cmd dir = ) end -def chooseWait : cmd int = +def chooseWait : Cmd Int = t <- random (16*2); return (16 + t) end @@ -35,7 +35,7 @@ end def disappointed = \cat. say "meow??"; cat end -def follow : cmd unit -> actor -> cmd unit = \cat. \r. +def follow : Cmd Unit -> Actor -> Cmd Unit = \cat. \r. rLoc <- as r {whereami}; myLoc <- whereami; let dx = fst rLoc - fst myLoc in diff --git a/data/scenarios/Challenges/_hackman/ghost.sw b/data/scenarios/Challenges/_hackman/ghost.sw index 387515dc..581ae87e 100644 --- a/data/scenarios/Challenges/_hackman/ghost.sw +++ b/data/scenarios/Challenges/_hackman/ghost.sw @@ -37,7 +37,7 @@ def checkRightBlocked = return isBlocked; end; -def chooseDirection : cmd dir = +def chooseDirection : Cmd Dir = leftBlocked <- checkLeftBlocked; rightBlocked <- checkRightBlocked; forwardBlocked <- isBlockedAhead; @@ -139,4 +139,4 @@ def waitToStart = go; end; -waitToStart; \ No newline at end of file +waitToStart; diff --git a/data/scenarios/Challenges/_hanoi/hanoi-solution.sw b/data/scenarios/Challenges/_hanoi/hanoi-solution.sw index dc62f37e..20ab288e 100644 --- a/data/scenarios/Challenges/_hanoi/hanoi-solution.sw +++ b/data/scenarios/Challenges/_hanoi/hanoi-solution.sw @@ -42,12 +42,12 @@ def moveToCol = \w.\x. end; def hanoi : - int -> // The number of disks in each column - int -> // Current column (basically offset of all columns) - int -> // The offset to first column - int -> // The offset to second column - int -> // The offset to third column - cmd int + Int -> // The number of disks in each column + Int -> // Current column (basically offset of all columns) + Int -> // The offset to first column + Int -> // The offset to second column + Int -> // The offset to third column + Cmd Int = \n. \o. \a. \b. \c. if (n == 0) {return o} { diff --git a/data/scenarios/Challenges/_lights-out/assistant.sw b/data/scenarios/Challenges/_lights-out/assistant.sw index 4ba42a8f..d4a23478 100644 --- a/data/scenarios/Challenges/_lights-out/assistant.sw +++ b/data/scenarios/Challenges/_lights-out/assistant.sw @@ -7,7 +7,7 @@ def boolToInt = \b. end; // modulus function (%) -def mod : int -> int -> int = \i.\m. +def mod : Int -> Int -> Int = \i.\m. i - m * (i / m) end @@ -137,7 +137,7 @@ def advanceRowViaTeleport = teleport self (0, snd curLoc - 1); end; -def shouldCorrectTile : (bool * bool) -> (bool * bool) -> cmd bool = \evenOverlaps. \isQuietTiles. +def shouldCorrectTile : (Bool * Bool) -> (Bool * Bool) -> Cmd Bool = \evenOverlaps. \isQuietTiles. if (evenOverlaps == isQuietTiles) { toggleLightHere; return true; @@ -220,7 +220,7 @@ def atLocation = \newLoc. \f. return retval; end; -def analyzeSolvability : int -> int -> cmd (bool * bool) = \boardWidth. \boardHeight. +def analyzeSolvability : Int -> Int -> Cmd (Bool * Bool) = \boardWidth. \boardHeight. atLocation (0, 0) $ checkIsSolvable boardWidth boardHeight; end; @@ -272,4 +272,4 @@ def go = observe; end; -go; \ No newline at end of file +go; diff --git a/data/scenarios/Challenges/_maypole/monitor.sw b/data/scenarios/Challenges/_maypole/monitor.sw index a0720262..2bb6f514 100644 --- a/data/scenarios/Challenges/_maypole/monitor.sw +++ b/data/scenarios/Challenges/_maypole/monitor.sw @@ -2,7 +2,7 @@ def elif = \t. \then. \else. {if t then else} end def else = \t. t end def abs = \n. if (n < 0) {-n} {n} end // modulus function (%) -def mod : int -> int -> int = \i.\m. +def mod : Int -> Int -> Int = \i.\m. i - m * (i / m) end @@ -17,7 +17,7 @@ Quadrants are numbered counter-clockwise, staring in the northeast: This is same as the standard graph quadrants in mathematics, except for 0-based numbering rather than 1-based. */ -def getQuadrant : (int * int) -> (int * int) -> int = \baseLoc. \myLoc. +def getQuadrant : (Int * Int) -> (Int * Int) -> Int = \baseLoc. \myLoc. let baseX = fst baseLoc in let baseY = snd baseLoc in @@ -53,7 +53,7 @@ def getQuadrantIncrement = \oldQuadrant. \newQuadrant. $ else {0} end; -def getCurrentQuadrant : (int * int) -> cmd int = \myLoc. +def getCurrentQuadrant : (Int * Int) -> Cmd Int = \myLoc. baseLoc <- as base {whereami}; return $ getQuadrant baseLoc myLoc; end; @@ -80,7 +80,7 @@ Also, the edge case for disregarding "diagonal" teleportation means that the traversal number could get out of sync with the absolute quadrant index. */ -def monitorAngle : (int * int) -> int -> int -> int -> cmd unit = +def monitorAngle : (Int * Int) -> Int -> Int -> Int -> Cmd Unit = \myLoc. \targetQuadrantCount. \prevQuadrant. \quadrantTraversalCount. result <- instant $ checkNewQuadrant myLoc prevQuadrant quadrantTraversalCount; let currentQuadrant = fst result in diff --git a/data/scenarios/Challenges/blender.yaml b/data/scenarios/Challenges/blender.yaml index 236e63d4..fb1cbabc 100644 --- a/data/scenarios/Challenges/blender.yaml +++ b/data/scenarios/Challenges/blender.yaml @@ -44,7 +44,7 @@ objectives: Distinguishes system bots from the base by name. Returns true if a bot has "met" the base. */ - def anyHasMetBase : int -> cmd bool = \idx. + def anyHasMetBase : Int -> Cmd Bool = \idx. try { bot <- robotnumbered idx; diff --git a/data/scenarios/Fun/GoL.yaml b/data/scenarios/Fun/GoL.yaml index 788e18ed..a7104711 100644 --- a/data/scenarios/Fun/GoL.yaml +++ b/data/scenarios/Fun/GoL.yaml @@ -35,7 +35,7 @@ robots: b <- scan back; return (cnt h + cnt f + cnt b) end; - def mod : int -> int -> int = \a. \b. a - (a/b)*b end; + def mod : Int -> Int -> Int = \a. \b. a - (a/b)*b end; def waitUntil = \p. b <- p; if b {wait 1} {waitUntil p} diff --git a/data/scenarios/Fun/_logo-burst/coordinator.sw b/data/scenarios/Fun/_logo-burst/coordinator.sw index 8a165f2c..72847886 100644 --- a/data/scenarios/Fun/_logo-burst/coordinator.sw +++ b/data/scenarios/Fun/_logo-burst/coordinator.sw @@ -1,4 +1,4 @@ -def forever : cmd unit -> cmd unit = \c. c ; forever c end +def forever : Cmd Unit -> Cmd Unit = \c. c ; forever c end def alternate = wait 50; @@ -9,4 +9,4 @@ def alternate = make "bit (0)"; end; -forever alternate; \ No newline at end of file +forever alternate; diff --git a/data/scenarios/Fun/_logo-burst/drone.sw b/data/scenarios/Fun/_logo-burst/drone.sw index 6cd4d523..1bdf2c26 100644 --- a/data/scenarios/Fun/_logo-burst/drone.sw +++ b/data/scenarios/Fun/_logo-burst/drone.sw @@ -1,12 +1,12 @@ -def repeat : int -> cmd unit -> cmd unit = +def repeat : Int -> Cmd Unit -> Cmd Unit = \n. \c. if (n == 0) {} {c ; repeat (n-1) c} end def abs = \n. if (n < 0) {-n} {n} end def elif = \t. \then. \else. {if t then else} end def else = \t. t end -def randdir : cmd dir = +def randdir : Cmd Dir = d <- random 4; return ( if (d == 0) {north} @@ -64,4 +64,4 @@ def go = \loc. end; loc <- whereami; -go loc; \ No newline at end of file +go loc; diff --git a/data/scenarios/Fun/_snake/snake.sw b/data/scenarios/Fun/_snake/snake.sw index 3266533b..839b4d74 100644 --- a/data/scenarios/Fun/_snake/snake.sw +++ b/data/scenarios/Fun/_snake/snake.sw @@ -2,11 +2,11 @@ Uses a string to maintain a queue of coordinates. */ -def coordsToString : (int * int) -> text = \coords. +def coordsToString : (Int * Int) -> Text = \coords. format (fst coords) ++ "," ++ format (snd coords) end -def indexOfRec : int -> text -> text -> (unit + int) = \pos. \inputString. \targetChar. +def indexOfRec : Int -> Text -> Text -> (Unit + Int) = \pos. \inputString. \targetChar. if (pos >= chars inputString) { inL () } { @@ -18,16 +18,16 @@ def indexOfRec : int -> text -> text -> (unit + int) = \pos. \inputString. \targ } end -def indexOf : text -> text -> (unit + int) = +def indexOf : Text -> Text -> (Unit + Int) = indexOfRec 0 end // Drops the first character of a string -def strTail : text -> text = \inputString. +def strTail : Text -> Text = \inputString. snd $ split 1 inputString end -def splitOnFirstChar : text -> text -> (text * text) = \inputString. \splitChar. +def splitOnFirstChar : Text -> Text -> (Text * Text) = \inputString. \splitChar. case (indexOf inputString splitChar) (\_. // Did not find the split character, so return the original string (inputString, "") @@ -42,13 +42,13 @@ def getDecimalCharValue = \inputString. \idx. end // Works from right to left -def parseDecimalRec : int -> text -> int = \charsRemaining. \inputString. +def parseDecimalRec : Int -> Text -> Int = \charsRemaining. \inputString. if (charsRemaining > 0) { getDecimalCharValue inputString (charsRemaining - 1) + 10 * parseDecimalRec (charsRemaining - 1) inputString } {0} end -def parseDecimal : text -> int = \inputString. +def parseDecimal : Text -> Int = \inputString. let isNegative = toChar (charAt 0 inputString) == "-" in let negationMultiplier = if isNegative {-1} {1} in let modifiedString = if isNegative {strTail inputString} {inputString} in @@ -57,19 +57,19 @@ def parseDecimal : text -> int = \inputString. end // Comma (",") is the separator between abscissa and ordinate -def stringToCoords : text -> (int * int) = \coordsString. +def stringToCoords : Text -> (Int * Int) = \coordsString. let pair = splitOnFirstChar coordsString "," in (parseDecimal $ fst pair, parseDecimal $ snd pair) end // APPEND to string representation of a coordinate list -def snoc : (int * int) -> text -> text = \coords. \strList. +def snoc : (Int * Int) -> Text -> Text = \coords. \strList. let delimiter = if (chars strList > 0) {";"} {""} in strList ++ delimiter ++ coordsToString coords; end // Extracts the first element and returns the shortened list -def pop : text -> (unit + ((int * int) * text)) = \strList. +def pop : Text -> (Unit + ((Int * Int) * Text)) = \strList. if (chars strList > 0) { let pair = splitOnFirstChar strList ";" in inR (stringToCoords $ fst pair, snd pair) diff --git a/data/scenarios/Fun/horton.yaml b/data/scenarios/Fun/horton.yaml index 9de32749..24987c3a 100644 --- a/data/scenarios/Fun/horton.yaml +++ b/data/scenarios/Fun/horton.yaml @@ -53,7 +53,7 @@ entities: - | Enables the `path` command: - | - `path : (unit + int) -> ((int * int) + text) -> cmd (unit + (dir * int))` + `path : (Unit + Int) -> ((Int * Int) + Text) -> Cmd (Unit + (Dir * Int))` - | Optionally supply a distance limit as the first argument, and supply either a location (`inL`) or an entity (`inR`) as the second argument. diff --git a/data/scenarios/Testing/1721-walkability-whitelist-path-cache.yaml b/data/scenarios/Testing/1721-walkability-whitelist-path-cache.yaml index 2d3910b1..1522a5cf 100644 --- a/data/scenarios/Testing/1721-walkability-whitelist-path-cache.yaml +++ b/data/scenarios/Testing/1721-walkability-whitelist-path-cache.yaml @@ -34,7 +34,7 @@ entities: - | Enables the `path` command: - | - `path : (unit + int) -> ((int * int) + text) -> cmd (unit + (dir * int))` + `path : (Unit + Int) -> ((Int * Int) + Text) -> Cmd (Unit + (Dir * Int))` - | Optionally supply a distance limit as the first argument, and supply either a location (`inL`) or an entity (`inR`) as the second argument. diff --git a/data/scenarios/Tutorials/bind2.yaml b/data/scenarios/Tutorials/bind2.yaml index d26c2bac..ec8e8f9a 100644 --- a/data/scenarios/Tutorials/bind2.yaml +++ b/data/scenarios/Tutorials/bind2.yaml @@ -29,13 +29,13 @@ objectives: - | Every command returns a value. However, some simple commands, like `move`, do not have any meaningful - value to return. Swarm has a special type, `unit`{=type}, with only one value, + value to return. Swarm has a special type, `Unit`{=type}, with only one value, called `()`. Since there is only one possible value of type - `unit`{=type}, returning it does not convey any information. - Thus, the type of `move` is `cmd unit`{=type}. + `Unit`{=type}, returning it does not convey any information. + Thus, the type of `move` is `Cmd Unit`{=type}. - | Other commands do return a nontrivial value after executing. - For example, `grab` has type `cmd text`{=type}, and returns the name of the + For example, `grab` has type `Cmd Text`{=type}, and returns the name of the grabbed entity as a text value. - | To use the result of a command later, you need _bind notation_, which diff --git a/data/scenarios/Tutorials/conditionals.yaml b/data/scenarios/Tutorials/conditionals.yaml index 2ac2ff4d..b569212f 100644 --- a/data/scenarios/Tutorials/conditionals.yaml +++ b/data/scenarios/Tutorials/conditionals.yaml @@ -13,9 +13,9 @@ objectives: to sweep over the entire 4x4 square and pick up a `very small rock`{=entity} any time you detect one. - | - The `ishere` command, with type `text -> cmd bool`{=type}, can be used + The `ishere` command, with type `Text -> Cmd Bool`{=type}, can be used for detecting the presence of a specific item such as a `very small rock`{=entity}. - What we need is a way to take the `bool`{=type} output from `ishere` + What we need is a way to take the `Bool`{=type} output from `ishere` and use it to decide whether to `grab` a rock or not. (Trying to execute `grab` in a cell without anything to grab will throw an exception, causing the robot to crash.) @@ -25,7 +25,7 @@ objectives: it is simply a built-in function of type - | ``` - if : bool -> {a} -> {a} -> a + if : Bool -> {a} -> {a} -> a ``` - | It takes a boolean expression and then returns either the first or second subsequent @@ -37,20 +37,20 @@ objectives: is called. Delayed expressions, on the other hand, are not evaluated until needed. In this case, we want to make sure that only the correct branch is evaluated. To write a value - of type, say, `{int}`{=type}, we just surround a value of type `int`{=type} + of type, say, `{Int}`{=type}, we just surround a value of type `Int`{=type} in curly braces, like `{3}`. This is why arguments to `build` must also be in curly braces: the type of `build` - is `{cmd a} -> cmd actor`{=type}. + is `{Cmd a} -> Cmd Actor`{=type}. - | - **TIP:** Note that `if` requires a `bool`{=type}, not a `cmd bool`{=type}! So you cannot directly say + **TIP:** Note that `if` requires a `Bool`{=type}, not a `Cmd Bool`{=type}! So you cannot directly say `if (ishere "very small rock") {...} {...}`{=snippet}. Instead you can write `b <- ishere "very small rock"; if b {...} {...}`{=snippet}. You might enjoy writing your own function of - type `cmd bool -> {cmd a} -> {cmd a} -> cmd a`{=type} to encapsulate this pattern. + type `Cmd Bool -> {Cmd a} -> {Cmd a} -> Cmd a`{=type} to encapsulate this pattern. - | **TIP:** the two branches of an `if` must have the same type. In particular, `if ... {grab} {}`{=snippet} is not - allowed, because `{grab}` has type `{cmd text}`{=type} whereas `{}`{=snippet} has type `{cmd unit}`{=type}. + allowed, because `{grab}` has type `{Cmd Text}`{=type} whereas `{}`{=snippet} has type `{Cmd Unit}`{=type}. In this case `{grab; return ()}` has the right type. condition: | try { diff --git a/data/scenarios/Tutorials/crash-secret.sw b/data/scenarios/Tutorials/crash-secret.sw index 0e8509b0..b050bb5d 100644 --- a/data/scenarios/Tutorials/crash-secret.sw +++ b/data/scenarios/Tutorials/crash-secret.sw @@ -15,7 +15,7 @@ def iterate = \state.\com. end; // At the beginning all robots can be given Win. -def allOK: actor -> bool = \rob. +def allOK: Actor -> Bool = \rob. true end; @@ -23,8 +23,8 @@ myLoc <- whereami; // Try to give a robot a Win, filtering out those that were already given a Win. // The robot will also receive instructions, so it **must have a logger!** -def tryGive: text -> (actor -> bool) -> cmd (actor -> bool) = \msg. - // (b -> actor -> cmd b) -> b -> cmd b +def tryGive: Text -> (Actor -> Bool) -> Cmd (Actor -> Bool) = \msg. + // (b -> Actor -> Cmd b) -> b -> Cmd b meetAll $ \f.\rob. if (not $ f rob) { log $ "skipping the robot " ++ format rob ++ "because it already has a Win"; diff --git a/data/scenarios/Tutorials/def.yaml b/data/scenarios/Tutorials/def.yaml index 8125dff2..0a93b606 100644 --- a/data/scenarios/Tutorials/def.yaml +++ b/data/scenarios/Tutorials/def.yaml @@ -11,9 +11,9 @@ objectives: that can be used to define new commands. For example: - | ``` - def m4 : cmd unit = move; move; move; move end + def m4 : Cmd Unit = move; move; move; move end ``` - - defines a new command `m4`{=snippet}, with type `cmd unit`{=type}, as four consecutive `move` commands. With judicious use of new definitions, it should be possible to complete this challenge in just a few lines of code. + - defines a new command `m4`{=snippet}, with type `Cmd Unit`{=type}, as four consecutive `move` commands. With judicious use of new definitions, it should be possible to complete this challenge in just a few lines of code. - | **TIP:** your base is at coordinates `(0,0)`, and the `flower`{=entity} is at `(16,4)`, which you can confirm by clicking in the world map panel. When you click on a cell, diff --git a/data/scenarios/Tutorials/farming.sw b/data/scenarios/Tutorials/farming.sw index aea3c941..5481d8cd 100644 --- a/data/scenarios/Tutorials/farming.sw +++ b/data/scenarios/Tutorials/farming.sw @@ -5,13 +5,13 @@ def tR = turn right end; def tL = turn left end; def tB = turn back end; def forever = \c. c ; forever c end; -def ifC : cmd bool -> {cmd a} -> {cmd a} -> cmd a = \test. \then. \else. +def ifC : Cmd Bool -> {Cmd a} -> {Cmd a} -> Cmd a = \test. \then. \else. b <- test; if b then else end; -def while : cmd bool -> {cmd a} -> cmd unit = \test. \body. +def while : Cmd Bool -> {Cmd a} -> Cmd Unit = \test. \body. ifC test {force body ; while test body} {} end; -def giveall : actor -> text -> cmd unit = \r. \thing. +def giveall : Actor -> Text -> Cmd Unit = \r. \thing. while (has thing) {give r thing} end; def x4 = \c. c; c; c; c end; @@ -19,13 +19,13 @@ def m4 = x4 move end; def x12 = \c. x4 (c;c;c) end; def m12 = x12 move end; def next_row = tB; m12; tL; move; tL end; -def plant_field : text -> cmd unit = \thing. +def plant_field : Text -> Cmd Unit = \thing. x4 ( x12 (move; place thing; harvest); next_row ) end; -def harvest_field : text -> cmd unit = \thing. +def harvest_field : Text -> Cmd Unit = \thing. x4 ( x12 (move; ifC (ishere thing) {harvest; return ()} {}); next_row diff --git a/data/scenarios/Tutorials/lambda.yaml b/data/scenarios/Tutorials/lambda.yaml index d07a338f..6cc8cbdd 100644 --- a/data/scenarios/Tutorials/lambda.yaml +++ b/data/scenarios/Tutorials/lambda.yaml @@ -16,7 +16,7 @@ objectives: one more than `x`{=snippet}. As another example: - | ``` - def x4 : cmd unit -> cmd unit = \c. c; c; c; c end + def x4 : Cmd Unit -> Cmd Unit = \c. c; c; c; c end ``` - That is, `x4`{=snippet} is defined as the function which takes a command, called `c`{=snippet}, as input, and returns the command `c; c; c; c`{=snippet} which consists of executing `c`{=snippet} four times. condition: | diff --git a/data/scenarios/Tutorials/types.yaml b/data/scenarios/Tutorials/types.yaml index f6355e8a..22456996 100644 --- a/data/scenarios/Tutorials/types.yaml +++ b/data/scenarios/Tutorials/types.yaml @@ -6,8 +6,8 @@ objectives: - goal: - The Swarm programming language has a strong static type system. That is, every expression in the language has a type, and all the types must match up properly before a program can be executed. - To see the type of an expression, enter the expression at the REPL prompt (you do not need to execute it). If the expression type checks, its type will be displayed in gray text at the top right of the window. - - For example, if you try typing `move`, you can see that it has type `cmd unit`{=type}, which means that `move` is a command which returns a value of the `unit`{=type} type (the only value of type `unit`{=type} is called `()`). - - As another example, you can see that `turn` has type `dir -> cmd unit`{=type}, meaning that `turn` is a function which takes a direction as input and results in a command. + - For example, if you try typing `move`, you can see that it has type `Cmd Unit`{=type}, which means that `move` is a command which returns a value of the `Unit`{=type} type (the only value of type `Unit`{=type} is called `()`). + - As another example, you can see that `turn` has type `Dir -> Cmd Unit`{=type}, meaning that `turn` is a function which takes a direction as input and results in a command. - "Here are a few more expressions for you to try (feel free to try others as well):" - | `north` diff --git a/data/scenarios/Tutorials/world101.sw b/data/scenarios/Tutorials/world101.sw index 9d0bde51..6d5f1476 100644 --- a/data/scenarios/Tutorials/world101.sw +++ b/data/scenarios/Tutorials/world101.sw @@ -11,11 +11,11 @@ def m10 = m8;m2 end def mg = m; grab end -def get_3_trees : cmd unit = +def get_3_trees : Cmd Unit = tB; m; mg; mg; mg; tB; m4 end -def make_harvester : cmd unit = +def make_harvester : Cmd Unit = make "log"; make "log"; make "log"; make "board"; make "board"; make "board"; make "box"; @@ -23,11 +23,11 @@ def make_harvester : cmd unit = make "harvester" end -def get_lambda : cmd unit = +def get_lambda : Cmd Unit = m10; tR; m9; harvest; tB; m9; tL; m10 end -def solution : cmd unit = +def solution : Cmd Unit = build {get_3_trees}; wait 16; salvage; make_harvester; build {get_lambda}; wait 50; salvage diff --git a/data/scenarios/Vignettes/_roadway/coordinator.sw b/data/scenarios/Vignettes/_roadway/coordinator.sw index fff00786..78d7451d 100644 --- a/data/scenarios/Vignettes/_roadway/coordinator.sw +++ b/data/scenarios/Vignettes/_roadway/coordinator.sw @@ -1,4 +1,4 @@ -def forever : cmd unit -> cmd unit = \c. c ; forever c end +def forever : Cmd Unit -> Cmd Unit = \c. c ; forever c end /** Teleports to a new location to execute a function then returns to the original location before @@ -52,4 +52,4 @@ def alternate = changeToRed; end; -forever alternate; \ No newline at end of file +forever alternate; diff --git a/data/scenarios/Vignettes/_roadway/drone.sw b/data/scenarios/Vignettes/_roadway/drone.sw index ae24925c..9022825e 100644 --- a/data/scenarios/Vignettes/_roadway/drone.sw +++ b/data/scenarios/Vignettes/_roadway/drone.sw @@ -14,7 +14,7 @@ def mapTuple = \f. \t. end; // modulus function (%) -def mod : int -> int -> int = \i.\m. +def mod : Int -> Int -> Int = \i.\m. i - m * (i / m) end @@ -28,9 +28,9 @@ def isEven = \n. Decide where to initially teleport to based on the initial coords. */ def init : - [xMin : int, xMax : int, yMin : int, yMax : int] - -> [yWest : int, yEast : int, xSouth : int, xNorth : int] - -> cmd (bool * int) = \extents. \lanes. + [xMin : Int, xMax : Int, yMin : Int, yMax : Int] + -> [yWest : Int, yEast : Int, xSouth : Int, xNorth : Int] + -> Cmd (Bool * Int) = \extents. \lanes. let topCorner = (-18, 30) in absloc <- whereami; let loc = sumTuples absloc $ mapTuple (\x. -x) topCorner in @@ -68,9 +68,9 @@ def isGreenLight = \isLongitudinal. end; def getCanMove : - [xWest : int, xEast : int, ySouth : int, yNorth : int] - -> bool - -> cmd bool + [xWest : Int, xEast : Int, ySouth : Int, yNorth : Int] + -> Bool + -> Cmd Bool = \stoplines. \hasGreenLight. d <- heading; @@ -95,7 +95,7 @@ def getCanMove : return $ hasGreenLight || not (atStopLine || neighborIsStopped); end; -def doTunnelWrap : [xMin : int, xMax : int, yMin : int, yMax : int] -> cmd bool = \extents. +def doTunnelWrap : [xMin : Int, xMax : Int, yMin : Int, yMax : Int] -> Cmd Bool = \extents. myloc <- whereami; didWrap <- if (fst myloc < extents.xMin) { teleport self (extents.xMax, snd myloc); @@ -116,10 +116,10 @@ def doTunnelWrap : [xMin : int, xMax : int, yMin : int, yMax : int] -> cmd bool end; def moveWithWrap : - [xWest : int, xEast : int, ySouth : int, yNorth : int] - -> [xMin : int, xMax : int, yMin : int, yMax : int] // extents - -> bool - -> cmd (bool * bool) + [xWest : Int, xEast : Int, ySouth : Int, yNorth : Int] + -> [xMin : Int, xMax : Int, yMin : Int, yMax : Int] // extents + -> Bool + -> Cmd (Bool * Bool) = \stoplines. \extents. \isLongitudinal. hasGreenLight <- isGreenLight isLongitudinal; @@ -141,9 +141,9 @@ def moveWithWrap : end; def getNewDelayState : - bool - -> [moveDelay : int, transitionCountdown : int] - -> [moveDelay : int, transitionCountdown : int] + Bool + -> [moveDelay : Int, transitionCountdown : Int] + -> [moveDelay : Int, transitionCountdown : Int] = \canGo. \delayState. if (not canGo) { // reset to max delay and pause the countdown at max @@ -165,12 +165,12 @@ Initially we wait several ticks between movements. Then we continually decrease the delay by 1, until reaching no delay. */ def advance : - int - -> bool - -> [xWest : int, xEast : int, ySouth : int, yNorth : int] - -> [xMin : int, xMax : int, yMin : int, yMax : int] - -> [moveDelay : int, transitionCountdown : int] - -> cmd unit + Int + -> Bool + -> [xWest : Int, xEast : Int, ySouth : Int, yNorth : Int] + -> [xMin : Int, xMax : Int, yMin : Int, yMax : Int] + -> [moveDelay : Int, transitionCountdown : Int] + -> Cmd Unit = \idx. \isLongitudinal. \stoplines. \extents. \delayState. wait delayState.moveDelay; @@ -197,4 +197,4 @@ def go = advance idx isLongitudinal stoplines extents [moveDelay=5, transitionCountdown=2]; end; -go; \ No newline at end of file +go; diff --git a/example/BFS-clear.sw b/example/BFS-clear.sw index 8b0ae5e7..9448a1cd 100644 --- a/example/BFS-clear.sw +++ b/example/BFS-clear.sw @@ -2,24 +2,24 @@ // search, with robots spawning more robots. Fun, though not very practical // in classic mode. -def repeat : int -> cmd unit -> cmd unit = \n.\c. +def repeat : Int -> Cmd Unit -> Cmd Unit = \n.\c. if (n == 0) {} {c ; repeat (n-1) c} end; -def while : cmd bool -> cmd unit -> cmd unit = \test.\c. +def while : Cmd Bool -> Cmd Unit -> Cmd Unit = \test.\c. b <- test; if b {c ; while test c} {} end; -def getX : cmd int = +def getX : Cmd Int = pos <- whereami; return (fst pos); end; -def getY : cmd int = +def getY : Cmd Int = pos <- whereami; return (snd pos); end; -def gotoX : int -> cmd unit = \tgt. +def gotoX : Int -> Cmd Unit = \tgt. cur <- getX; if (cur == tgt) {} @@ -30,7 +30,7 @@ def gotoX : int -> cmd unit = \tgt. gotoX tgt } end; -def gotoY : int -> cmd unit = \tgt. +def gotoY : Int -> Cmd Unit = \tgt. cur <- getY; if (cur == tgt) {} @@ -41,8 +41,8 @@ def gotoY : int -> cmd unit = \tgt. gotoY tgt } end; -def goto : int -> int -> cmd unit = \x. \y. gotoX x; gotoY y; gotoX x; gotoY y end; -def spawnfwd : {cmd unit} -> cmd unit = \c. +def goto : Int -> Int -> Cmd Unit = \x. \y. gotoX x; gotoY y; gotoX x; gotoY y end; +def spawnfwd : {Cmd Unit} -> Cmd Unit = \c. try { move; b <- isHere "tree"; @@ -53,7 +53,7 @@ def spawnfwd : {cmd unit} -> cmd unit = \c. move } { turn back } end; -def clear : cmd unit = +def clear : Cmd Unit = grab; repeat 4 ( spawnfwd {clear}; @@ -63,4 +63,4 @@ def clear : cmd unit = give base "tree"; selfdestruct; end; -def start : cmd actor = build {turn west; repeat 7 move; clear} end +def start : Cmd Actor = build {turn west; repeat 7 move; clear} end diff --git a/example/cat.sw b/example/cat.sw index 439cdeb3..7d603a7f 100644 --- a/example/cat.sw +++ b/example/cat.sw @@ -1,10 +1,10 @@ // A "cat" that wanders around randomly. Shows off use of the // 'random' command. -let forever : cmd unit -> cmd unit = \c. c ; forever c in -let repeat : int -> cmd unit -> cmd unit = +let forever : Cmd Unit -> Cmd Unit = \c. c ; forever c in +let repeat : Int -> Cmd Unit -> Cmd Unit = \n. \c. if (n == 0) {} {c ; repeat (n-1) c} in -let randdir : cmd dir = +let randdir : Cmd Dir = d <- random 4; return ( if (d == 0) {north} diff --git a/example/dfs.sw b/example/dfs.sw index e67d26e6..f781f16d 100644 --- a/example/dfs.sw +++ b/example/dfs.sw @@ -1,8 +1,8 @@ -def ifC : forall a. cmd bool -> {cmd a} -> {cmd a} -> cmd a = +def ifC : forall a. Cmd Bool -> {Cmd a} -> {Cmd a} -> Cmd a = \test. \thn. \els. b <- test; if b thn els end // Recursive DFS to harvest a contiguous forest -def dfs : cmd unit = +def dfs : Cmd Unit = ifC (ishere "tree") { grab; turn west; diff --git a/example/fact.sw b/example/fact.sw index 2465636a..0aee81ce 100644 --- a/example/fact.sw +++ b/example/fact.sw @@ -1,10 +1,10 @@ // Defining simple recursive functions. -def repeat : int -> cmd unit -> cmd unit = \n.\c. +def repeat : Int -> Cmd Unit -> Cmd Unit = \n.\c. if (n == 0) {} {c ; repeat (n-1) c} end -def fact : int -> int = \n:int. +def fact : Int -> Int = \n:Int. if (n == 0) {1} {n * fact (n-1)} diff --git a/example/list.sw b/example/list.sw index 69221c1c..fc05281d 100644 --- a/example/list.sw +++ b/example/list.sw @@ -29,7 +29,7 @@ // // TODO: once #153 is resolved, add types to definitions // -// type listI = int +// type ListI = Int /*******************************************************************/ /* LAYOUT */ @@ -56,31 +56,31 @@ vvvvvvvvvvvv vvvvvvvvvvvvvvvvvvvvvvvvv vvv /*******************************************************************/ // bitlength of a number (shifting by one) -def naive_len : int -> int = \i. +def naive_len : Int -> Int = \i. if (i == 0) {0} {1 + naive_len (i/2)} end // modulus function (%) -def mod : int -> int -> int = \i.\m. +def mod : Int -> Int -> Int = \i.\m. i - m * (i / m) end // f X Y = Y * 2^(-X) -def shiftL : int -> int -> int = \s.\i. +def shiftL : Int -> Int -> Int = \s.\i. i / 2^s end // f X Y = Y * 2^(X) -def shiftR : int -> int -> int = \s.\i. +def shiftR : Int -> Int -> Int = \s.\i. i * 2^s end // shift by (8bit) bytes -def shiftLH : int -> int -> int = \s. shiftL (s*8) end -def shiftRH : int -> int -> int = \s. shiftR (s*8) end +def shiftLH : Int -> Int -> Int = \s. shiftL (s*8) end +def shiftRH : Int -> Int -> Int = \s. shiftR (s*8) end // bitlength of a number (shifting by 64) -def len : int -> int = \i. +def len : Int -> Int = \i. let next = i / 2^64 in if (next == 0) {naive_len i} {64 + len next} end @@ -89,11 +89,11 @@ end /* helper functions */ /*******************************************************************/ -def getLenPart : int -> int = \i. mod (i/2) (2^7) end -def setLenPart : int -> int = \i. 2 * (mod i (2^7)) end +def getLenPart : Int -> Int = \i. mod (i/2) (2^7) end +def setLenPart : Int -> Int = \i. 2 * (mod i (2^7)) end // Split length into 7-bit parts and prefix all but last with 1 -def to1numA : int -> int * int = \i. +def to1numA : Int -> Int * Int = \i. let nextPart = shiftL 7 i in if (nextPart == 0) { ((2 * i), 1) } /* last part */ @@ -107,7 +107,7 @@ end // Get bitlength of the first number in the list // and also the list starting at the number itself // -// getLenA : listI -> int * int +// getLenA : ListI -> Int * Int def getLenA = \xs. let isEnd = 0 == mod xs 2 in let l = getLenPart xs in @@ -123,7 +123,7 @@ end /* LIST FUNCTIONS */ /*******************************************************************/ -// headTail : listI -> {int} * {listI} +// headTail : ListI -> {Int} * {ListI} def headTail = \xs. let sign = mod xs 2 in let ns = xs / 2 in @@ -135,21 +135,21 @@ def headTail = \xs. ) end -// head : listI -> int -def head : int -> int = \xs. +// head : ListI -> Int +def head : Int -> Int = \xs. force $ fst $ headTail xs end -// tail : listI -> listI +// tail : ListI -> ListI def tail = \xs. force $ snd $ headTail xs end -// nil : listI +// nil : ListI def nil = 0 end // Add non-negative number to beginning of list (cons adds the sign) -// consP : nat -> listI -> int +// consP : nat -> ListI -> Int def consP = \x.\xs. if (x == 0) { 2 /* header says one bit length */ + shiftR (8+1) xs} @@ -160,7 +160,7 @@ def consP = \x.\xs. end // Add integer to the beginning of the list -// consP : int -> listI -> listI +// consP : Int -> ListI -> ListI def cons = \x.\xs. if (x >= 0) { 2 * consP x xs } @@ -172,19 +172,19 @@ end /* MORE LIST FUNCTIONS */ /*******************************************************************/ -// index : int -> listI -> int +// index : Int -> ListI -> Int def index = \i.\xs. if (i <= 0) {head xs} {index (i-1) (tail xs)} end -def for : int -> int -> (int -> cmd a) -> cmd unit = \s.\e.\act. +def for : Int -> Int -> (Int -> Cmd a) -> Cmd Unit = \s.\e.\act. if (s == e) {} {act s; for (s+1) e act} end -// for_each_i : int -> listI int -> (int * int -> cmd a) -> cmd unit +// for_each_i : Int -> ListI Int -> (Int * Int -> Cmd a) -> Cmd Unit def for_each_i = \i.\xs.\act. if (xs == nil) {} { let ht = headTail xs @@ -192,7 +192,7 @@ def for_each_i = \i.\xs.\act. } end -// for_each : listI int -> (int -> cmd a) -> cmd unit +// for_each : ListI Int -> (Int -> Cmd a) -> Cmd Unit def for_each = \xs.\act. for_each_i 0 xs (\i. act) end diff --git a/example/multi-key-handler.sw b/example/multi-key-handler.sw index a234778d..712a6e29 100644 --- a/example/multi-key-handler.sw +++ b/example/multi-key-handler.sw @@ -5,16 +5,16 @@ def cons : a * b -> (a -> b) -> (a -> b) = \p. \k. \a. if (a == fst p) {snd p} {k a} end -def nil : a -> cmd unit = \a. return () end +def nil : a -> Cmd Unit = \a. return () end // The delay around the first argument is necessary to prevent // infinite recursion -def handlerB : {key -> cmd unit} -> key -> cmd unit = \hA. \k. +def handlerB : {Key -> Cmd Unit} -> Key -> Cmd Unit = \hA. \k. cons (key "b", move) nil k; installKeyHandler "" (force hA) end // Typing 'a' then 'b' in sequence will cause the robot to move. -def handlerA : key -> cmd unit = +def handlerA : Key -> Cmd Unit = cons (key "a", installKeyHandler "" (handlerB {handlerA})) nil end diff --git a/example/pilotmode.sw b/example/pilotmode.sw index b3d632ea..7d19fb18 100644 --- a/example/pilotmode.sw +++ b/example/pilotmode.sw @@ -2,11 +2,11 @@ def cons : a * b -> (a -> b) -> (a -> b) = \p. \k. \a. if (a == fst p) {snd p} {k a} end -def nil : a -> cmd unit = \a. return () end +def nil : a -> Cmd Unit = \a. return () end // Suitable to use as e.g. // installKeyHandler "(S-)←↓↑→ [Del] [g]rab [h]arvest [d]rill [s]can [b]locked [u]pload" pilot -def pilot : key -> cmd unit = +def pilot : Key -> Cmd Unit = cons (key "Up", move) $ cons (key "Down", turn back) $ cons (key "Left", turn left) $ diff --git a/example/wander.sw b/example/wander.sw index cb1ebdb9..55165996 100644 --- a/example/wander.sw +++ b/example/wander.sw @@ -1,9 +1,9 @@ -def forever : {cmd unit} -> cmd unit = +def forever : {Cmd Unit} -> Cmd Unit = \c. force c ; forever c end // Wander randomly forever. -def wander : cmd unit = +def wander : Cmd Unit = forever { b <- random 2; turn (if (b == 0) {left} {right}); diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index e04b2133..7b9dcedb 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -725,7 +725,7 @@ stepCESK cesk = case cesk of return $ In (TDelay (MemoizedDelay $ bool Nothing (Just x) r) t) e s (FDef x : k) -- Once we have finished evaluating the (memoized, delayed) body of -- a definition, we return a special VResult value, which packages - -- up the return value from the @def@ command itself (@unit@) + -- up the return value from the @def@ command itself (the unit value) -- together with the resulting environment (the variable bound to -- the delayed value). Out v s (FDef x : k) -> diff --git a/src/swarm-engine/Swarm/Game/Step/Const.hs b/src/swarm-engine/Swarm/Game/Step/Const.hs index 8b28441e..24da1de6 100644 --- a/src/swarm-engine/Swarm/Game/Step/Const.hs +++ b/src/swarm-engine/Swarm/Game/Step/Const.hs @@ -642,8 +642,8 @@ execConst runChildProg c vs s k = do -- In general, (1) entities might not have an orientation, and -- (2) even if they do, orientation is a general vector, which -- might not correspond to a cardinal direction. We could make - -- 'heading' return a 'maybe dir' i.e. 'unit + dir', or return a - -- vector of type 'int * int', but those would both be annoying + -- 'heading' return a @Maybe Dir@ (/i.e./ @Unit + Dir@), or return a + -- vector of type @Int * Int@, but those would both be annoying -- for players in the vast majority of cases. We rather choose -- to just return the direction 'down' in any case where we don't -- otherwise have anything reasonable to return. diff --git a/src/swarm-lang/Swarm/Language/Parser/Lex.hs b/src/swarm-lang/Swarm/Language/Parser/Lex.hs index cb12e9c1..290888cc 100644 --- a/src/swarm-lang/Swarm/Language/Parser/Lex.hs +++ b/src/swarm-lang/Swarm/Language/Parser/Lex.hs @@ -26,9 +26,14 @@ module Swarm.Language.Parser.Lex ( symbol, operator, reservedWords, + reservedCS, reserved, - identifier, + IdentifierType (..), locIdentifier, + locTmVar, + identifier, + tyVar, + tmVar, textLiteral, integer, @@ -40,13 +45,17 @@ module Swarm.Language.Parser.Lex ( import Control.Lens (use, (%=), (.=)) import Control.Monad (void) +import Data.Char (isUpper) import Data.Containers.ListUtils (nubOrd) import Data.Sequence qualified as Seq -import Data.Text (Text, toLower) +import Data.Set (Set) +import Data.Set qualified as S +import Data.Text (Text) import Data.Text qualified as T import Swarm.Language.Parser.Core import Swarm.Language.Syntax -import Swarm.Util (failT, squote) +import Swarm.Language.Types (baseTyName) +import Swarm.Util (failT, listEnums, squote) import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer qualified as L @@ -142,54 +151,84 @@ operatorChar = T.singleton <$> oneOf opChars isOp = \case { ConstMFunc {} -> False; _ -> True } . constMeta opChars = nubOrd . concatMap (from . syntax) . filter isOp $ map constInfo allConst +-- | Names of base types built into the language. +baseTypeNames :: [Text] +baseTypeNames = map baseTyName listEnums + +-- | Names of types built into the language. +primitiveTypeNames :: [Text] +primitiveTypeNames = "Cmd" : baseTypeNames + +-- | List of keywords built into the language. +keywords :: [Text] +keywords = T.words "let in def end true false forall require requirements" + -- | List of reserved words that cannot be used as variable names. -reservedWords :: [Text] +reservedWords :: Set Text reservedWords = - map (syntax . constInfo) (filter isUserFunc allConst) - ++ map directionSyntax allDirs - ++ [ "void" - , "unit" - , "int" - , "text" - , "dir" - , "bool" - , "actor" - , "key" - , "cmd" - , "delay" - , "let" - , "def" - , "end" - , "in" - , "true" - , "false" - , "forall" - , "require" - , "requirements" - ] + S.fromList $ + map (syntax . constInfo) (filter isUserFunc allConst) + ++ map directionSyntax allDirs + ++ primitiveTypeNames + ++ keywords --- | Parse a case-insensitive reserved word, making sure it is not a --- prefix of a longer variable name, and allowing the parser to --- backtrack if it fails. +-- | Parse a reserved word, given a string recognizer (which can +-- /e.g./ be case sensitive or not), making sure it is not a prefix +-- of a longer variable name, and allowing the parser to backtrack +-- if it fails. +reservedGen :: (Text -> Parser a) -> Text -> Parser () +reservedGen str w = (lexeme . try) $ str w *> notFollowedBy (alphaNumChar <|> char '_') + +-- | Parse a case-sensitive reserved word. +reservedCS :: Text -> Parser () +reservedCS = reservedGen string + +-- | Parse a case-insensitive reserved word. reserved :: Text -> Parser () -reserved w = (lexeme . try) $ string' w *> notFollowedBy (alphaNumChar <|> char '_') +reserved = reservedGen string' --- | Parse an identifier, i.e. any non-reserved string containing --- alphanumeric characters and underscores and not starting with a --- number. -identifier :: Parser Var -identifier = lvVar <$> locIdentifier +-- | What kind of identifier are we parsing? +data IdentifierType = IDTyVar | IDTmVar + deriving (Eq, Ord, Show) -- | Parse an identifier together with its source location info. -locIdentifier :: Parser LocVar -locIdentifier = uncurry LV <$> parseLocG ((lexeme . try) (p >>= check) "variable name") +locIdentifier :: IdentifierType -> Parser LocVar +locIdentifier idTy = uncurry LV <$> parseLocG ((lexeme . try) (p >>= check) "variable name") where p = (:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> char '_' <|> char '\'') check (into @Text -> t) - | toLower t `elem` reservedWords = - failT ["reserved word", squote t, "cannot be used as variable name"] + | t `S.member` reservedWords || T.toLower t `S.member` reservedWords = + failT ["Reserved word", squote t, "cannot be used as a variable name"] + | IDTyVar <- idTy + , T.toTitle t `S.member` reservedWords = + failT ["Reserved type name", squote t, "cannot be used as a type variable name; perhaps you meant", squote (T.toTitle t) <> "?"] + | IDTyVar <- idTy + , isUpper (T.head t) = + failT ["Type variable names must start with a lowercase letter"] | otherwise = return t +-- | Parse a term variable together with its source location info. +locTmVar :: Parser LocVar +locTmVar = locIdentifier IDTmVar + +-- | Parse an identifier, i.e. any non-reserved string containing +-- alphanumeric characters and underscores, not starting with a +-- digit. The Bool indicates whether we are parsing a type variable. +identifier :: IdentifierType -> Parser Var +identifier = fmap lvVar . locIdentifier + +-- | Parse a type variable, which must start with an underscore or +-- lowercase letter and cannot be the lowercase version of a type +-- name. +tyVar :: Parser Var +tyVar = identifier IDTyVar + +-- | Parse a term variable, which can start in any case and just +-- cannot be the same (case-insensitively) as a lowercase reserved +-- word. +tmVar :: Parser Var +tmVar = identifier IDTmVar + -- | Parse a text literal (including escape sequences) in double quotes. textLiteral :: Parser Text textLiteral = into <$> lexeme (char '"' >> manyTill L.charLiteral (char '"')) diff --git a/src/swarm-lang/Swarm/Language/Parser/Record.hs b/src/swarm-lang/Swarm/Language/Parser/Record.hs index c571e4b1..181fa389 100644 --- a/src/swarm-lang/Swarm/Language/Parser/Record.hs +++ b/src/swarm-lang/Swarm/Language/Parser/Record.hs @@ -12,20 +12,20 @@ import Data.Map (Map) import Data.Map qualified as M import Swarm.Language.Context (Var) import Swarm.Language.Parser.Core (Parser) -import Swarm.Language.Parser.Lex (identifier, symbol) +import Swarm.Language.Parser.Lex (symbol, tmVar) import Swarm.Util (failT, findDup, squote) import Text.Megaparsec (sepBy) --- | Parse something using record syntax of the form @{x1 = v1, x2 = --- v2, ...}@. The same parser is used both in parsing record types --- and record values, so it is factored out into its own module. +-- | Parse something using record syntax of the form @{x1 v1, x2 v2, +-- ...}@. The same parser is used both in parsing record types and +-- record values, so it is factored out into its own module. -- -- The @Parser a@ argument is the parser to use for the RHS of each -- binding in the record. parseRecord :: Parser a -> Parser (Map Var a) parseRecord p = (parseBinding `sepBy` symbol ",") >>= fromListUnique where - parseBinding = (,) <$> identifier <*> p + parseBinding = (,) <$> tmVar <*> p fromListUnique kvs = case findDup (map fst kvs) of Nothing -> return $ M.fromList kvs Just x -> failT ["duplicate field name", squote x, "in record literal"] diff --git a/src/swarm-lang/Swarm/Language/Parser/Term.hs b/src/swarm-lang/Swarm/Language/Parser/Term.hs index be53c812..d8c00c12 100644 --- a/src/swarm-lang/Swarm/Language/Parser/Term.hs +++ b/src/swarm-lang/Swarm/Language/Parser/Term.hs @@ -51,7 +51,7 @@ parseConst = asum (map alternative consts) "built-in user function" parseTermAtom :: Parser Syntax parseTermAtom = do s1 <- parseTermAtom2 - ps <- many (symbol "." *> parseLocG identifier) + ps <- many (symbol "." *> parseLocG tmVar) return $ foldl' (\(Syntax l1 t) (l2, x) -> Syntax (l1 <> l2) (TProj t x)) s1 ps -- | Parse an atomic term. @@ -60,7 +60,7 @@ parseTermAtom2 = parseLoc ( TUnit <$ symbol "()" <|> TConst <$> parseConst - <|> TVar <$> identifier + <|> TVar <$> tmVar <|> TDir <$> parseDirection <|> TInt <$> integer <|> TText <$> textLiteral @@ -75,16 +75,16 @@ parseTermAtom2 = ) <|> uncurry SRequirements <$> (reserved "requirements" *> match parseTerm) <|> SLam - <$> (symbol "\\" *> locIdentifier) + <$> (symbol "\\" *> locTmVar) <*> optional (symbol ":" *> parseType) <*> (symbol "." *> parseTerm) <|> sLet - <$> (reserved "let" *> locIdentifier) + <$> (reserved "let" *> locTmVar) <*> optional (symbol ":" *> parsePolytype) <*> (symbol "=" *> parseTerm) <*> (reserved "in" *> parseTerm) <|> sDef - <$> (reserved "def" *> locIdentifier) + <$> (reserved "def" *> locTmVar) <*> optional (symbol ":" *> parsePolytype) <*> (symbol "=" *> parseTerm <* reserved "end") <|> SRcd <$> brackets (parseRecord (optional (symbol "=" *> parseTerm))) @@ -112,8 +112,8 @@ sDef x ty t = SDef (lvVar x `S.member` setOf freeVarsV t) x ty t parseAntiquotation :: Parser Term parseAntiquotation = - TAntiText <$> (lexeme . try) (symbol "$str:" *> identifier) - <|> TAntiInt <$> (lexeme . try) (symbol "$int:" *> identifier) + TAntiText <$> (lexeme . try) (symbol "$str:" *> tmVar) + <|> TAntiInt <$> (lexeme . try) (symbol "$int:" *> tmVar) -- | Parse a Swarm language term. parseTerm :: Parser Syntax @@ -135,7 +135,7 @@ data Stmt parseStmt :: Parser Stmt parseStmt = - mkStmt <$> optional (try (locIdentifier <* symbol "<-")) <*> parseExpr + mkStmt <$> optional (try (locTmVar <* symbol "<-")) <*> parseExpr mkStmt :: Maybe LocVar -> Syntax -> Stmt mkStmt Nothing = BareTerm diff --git a/src/swarm-lang/Swarm/Language/Parser/Type.hs b/src/swarm-lang/Swarm/Language/Parser/Type.hs index 083f6dcb..64215f21 100644 --- a/src/swarm-lang/Swarm/Language/Parser/Type.hs +++ b/src/swarm-lang/Swarm/Language/Parser/Type.hs @@ -14,10 +14,19 @@ import Control.Monad.Combinators.Expr (Operator (..), makeExprParser) import Data.Maybe (fromMaybe) import Data.Set qualified as S import Swarm.Language.Parser.Core (Parser) -import Swarm.Language.Parser.Lex (braces, brackets, identifier, parens, reserved, symbol) +import Swarm.Language.Parser.Lex ( + braces, + brackets, + parens, + reserved, + reservedCS, + symbol, + tyVar, + ) import Swarm.Language.Parser.Record (parseRecord) import Swarm.Language.Types -import Text.Megaparsec (optional, some, (<|>)) +import Swarm.Util (listEnums) +import Text.Megaparsec (choice, optional, some, (<|>)) import Witch (from) -- | Parse a Swarm language polytype, which starts with an optional @@ -28,7 +37,7 @@ parsePolytype :: Parser Polytype parsePolytype = join $ ( quantify . fromMaybe [] - <$> optional ((reserved "forall" <|> reserved "∀") *> some identifier <* symbol ".") + <$> optional ((reserved "forall" <|> reserved "∀") *> some tyVar <* symbol ".") ) <*> parseType where @@ -59,28 +68,9 @@ parseType = makeExprParser parseTypeAtom table parseTypeAtom :: Parser Type parseTypeAtom = - TyVoid - <$ reserved "void" - <|> TyUnit - <$ reserved "unit" - <|> TyVar - <$> identifier - <|> TyInt - <$ reserved "int" - <|> TyText - <$ reserved "text" - <|> TyDir - <$ reserved "dir" - <|> TyBool - <$ reserved "bool" - <|> TyActor - <$ reserved "actor" - <|> TyKey - <$ reserved "key" - <|> TyCmd - <$> (reserved "cmd" *> parseTypeAtom) - <|> TyDelay - <$> braces parseType - <|> TyRcd - <$> brackets (parseRecord (symbol ":" *> parseType)) + choice (map (\b -> TyBase b <$ reservedCS (baseTyName b)) listEnums) + <|> TyCmd <$> (reservedCS "Cmd" *> parseTypeAtom) + <|> TyVar <$> tyVar + <|> TyDelay <$> braces parseType + <|> TyRcd <$> brackets (parseRecord (symbol ":" *> parseType)) <|> parens parseType diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index e552042c..b0df23d4 100644 --- a/src/swarm-lang/Swarm/Language/Pretty.hs +++ b/src/swarm-lang/Swarm/Language/Pretty.hs @@ -108,14 +108,7 @@ instance PrettyPrec Text where prettyPrec _ = pretty instance PrettyPrec BaseTy where - prettyPrec _ BVoid = "void" - prettyPrec _ BUnit = "unit" - prettyPrec _ BInt = "int" - prettyPrec _ BDir = "dir" - prettyPrec _ BText = "text" - prettyPrec _ BBool = "bool" - prettyPrec _ BActor = "actor" - prettyPrec _ BKey = "key" + prettyPrec _ = pretty . drop 1 . show instance PrettyPrec IntVar where prettyPrec _ = pretty . mkVarName "u" @@ -158,7 +151,7 @@ instance ((UnchainableFun t), (PrettyPrec t)) => PrettyPrec (TypeF t) where prettyPrec p (TyProdF ty1 ty2) = pparens (p > 2) $ prettyPrec 3 ty1 <+> "*" <+> prettyPrec 2 ty2 - prettyPrec p (TyCmdF ty) = pparens (p > 9) $ "cmd" <+> prettyPrec 10 ty + prettyPrec p (TyCmdF ty) = pparens (p > 9) $ "Cmd" <+> prettyPrec 10 ty prettyPrec _ (TyDelayF ty) = braces $ ppr ty prettyPrec p (TyFunF ty1 ty2) = let (iniF, lastF) = unsnocNE $ ty1 <| unchainFun ty2 diff --git a/src/swarm-lang/Swarm/Language/Typecheck.hs b/src/swarm-lang/Swarm/Language/Typecheck.hs index 833c9167..39ee02be 100644 --- a/src/swarm-lang/Swarm/Language/Typecheck.hs +++ b/src/swarm-lang/Swarm/Language/Typecheck.hs @@ -715,11 +715,11 @@ infer s@(CSyntax l t cs) = addLocToTypeErr l $ case t of -- type mismatches between the branches of an 'if' tend to get -- caught in the unifier, resulting in vague "can't unify" -- messages (for example, "if true {3} {move}" yields "can't - -- unify int and cmd unit"). With this 'applyBindings' call, we + -- unify Int and Cmd Unit"). With this 'applyBindings' call, we -- get more specific errors about how the second branch was -- expected to have the same type as the first (e.g. "expected - -- `move` to have type `int`, but it actually has type `cmd - -- unit`). + -- `move` to have type `Int`, but it actually has type `Cmd + -- Unit`). resTy' <- applyBindings resTy return $ Syntax' l (SApp f' x') cs resTy' @@ -780,116 +780,116 @@ infer s@(CSyntax l t cs) = addLocToTypeErr l $ case t of -- | Infer the type of a constant. inferConst :: Const -> Polytype inferConst c = case c of - Wait -> [tyQ| int -> cmd unit |] - Noop -> [tyQ| cmd unit |] - Selfdestruct -> [tyQ| cmd unit |] - Move -> [tyQ| cmd unit |] - Backup -> [tyQ| cmd unit |] - Volume -> [tyQ| int -> cmd (unit + int) |] - Path -> [tyQ| (unit + int) -> ((int * int) + text) -> cmd (unit + (dir * int)) |] - Push -> [tyQ| cmd unit |] - Stride -> [tyQ| int -> cmd unit |] - Turn -> [tyQ| dir -> cmd unit |] - Grab -> [tyQ| cmd text |] - Harvest -> [tyQ| cmd text |] - Ignite -> [tyQ| dir -> cmd unit |] - Place -> [tyQ| text -> cmd unit |] - Ping -> [tyQ| actor -> cmd (unit + (int * int)) |] - Give -> [tyQ| actor -> text -> cmd unit |] - Equip -> [tyQ| text -> cmd unit |] - Unequip -> [tyQ| text -> cmd unit |] - Make -> [tyQ| text -> cmd unit |] - Has -> [tyQ| text -> cmd bool |] - Equipped -> [tyQ| text -> cmd bool |] - Count -> [tyQ| text -> cmd int |] - Reprogram -> [tyQ| actor -> {cmd a} -> cmd unit |] - Build -> [tyQ| {cmd a} -> cmd actor |] - Drill -> [tyQ| dir -> cmd (unit + text) |] - Use -> [tyQ| text -> dir -> cmd (unit + text) |] - Salvage -> [tyQ| cmd unit |] - Say -> [tyQ| text -> cmd unit |] - Listen -> [tyQ| cmd text |] - Log -> [tyQ| text -> cmd unit |] - View -> [tyQ| actor -> cmd unit |] - Appear -> [tyQ| text -> (unit + text) -> cmd unit |] - Create -> [tyQ| text -> cmd unit |] - Halt -> [tyQ| actor -> cmd unit |] - Time -> [tyQ| cmd int |] - Scout -> [tyQ| dir -> cmd bool |] - Whereami -> [tyQ| cmd (int * int) |] - Waypoint -> [tyQ| text -> int -> cmd (int * (int * int)) |] - Structure -> [tyQ| text -> int -> cmd (unit + (int * (int * int))) |] - Floorplan -> [tyQ| text -> cmd (int * int) |] - HasTag -> [tyQ| text -> text -> cmd bool |] - TagMembers -> [tyQ| text -> int -> cmd (int * text) |] - Detect -> [tyQ| text -> ((int * int) * (int * int)) -> cmd (unit + (int * int)) |] - Resonate -> [tyQ| text -> ((int * int) * (int * int)) -> cmd int |] - Density -> [tyQ| ((int * int) * (int * int)) -> cmd int |] - Sniff -> [tyQ| text -> cmd int |] - Chirp -> [tyQ| text -> cmd dir |] - Watch -> [tyQ| dir -> cmd unit |] - Surveil -> [tyQ| (int * int) -> cmd unit |] - Heading -> [tyQ| cmd dir |] - Blocked -> [tyQ| cmd bool |] - Scan -> [tyQ| dir -> cmd (unit + text) |] - Upload -> [tyQ| actor -> cmd unit |] - Ishere -> [tyQ| text -> cmd bool |] - Isempty -> [tyQ| cmd bool |] - Self -> [tyQ| actor |] - Parent -> [tyQ| actor |] - Base -> [tyQ| actor |] - Meet -> [tyQ| cmd (unit + actor) |] - MeetAll -> [tyQ| (b -> actor -> cmd b) -> b -> cmd b |] - Whoami -> [tyQ| cmd text |] - Setname -> [tyQ| text -> cmd unit |] - Random -> [tyQ| int -> cmd int |] - Run -> [tyQ| text -> cmd unit |] - If -> [tyQ| bool -> {a} -> {a} -> a |] + Wait -> [tyQ| Int -> Cmd Unit |] + Noop -> [tyQ| Cmd Unit |] + Selfdestruct -> [tyQ| Cmd Unit |] + Move -> [tyQ| Cmd Unit |] + Backup -> [tyQ| Cmd Unit |] + Volume -> [tyQ| Int -> Cmd (Unit + Int) |] + Path -> [tyQ| (Unit + Int) -> ((Int * Int) + Text) -> Cmd (Unit + (Dir * Int)) |] + Push -> [tyQ| Cmd Unit |] + Stride -> [tyQ| Int -> Cmd Unit |] + Turn -> [tyQ| Dir -> Cmd Unit |] + Grab -> [tyQ| Cmd Text |] + Harvest -> [tyQ| Cmd Text |] + Ignite -> [tyQ| Dir -> Cmd Unit |] + Place -> [tyQ| Text -> Cmd Unit |] + Ping -> [tyQ| Actor -> Cmd (Unit + (Int * Int)) |] + Give -> [tyQ| Actor -> Text -> Cmd Unit |] + Equip -> [tyQ| Text -> Cmd Unit |] + Unequip -> [tyQ| Text -> Cmd Unit |] + Make -> [tyQ| Text -> Cmd Unit |] + Has -> [tyQ| Text -> Cmd Bool |] + Equipped -> [tyQ| Text -> Cmd Bool |] + Count -> [tyQ| Text -> Cmd Int |] + Reprogram -> [tyQ| Actor -> {Cmd a} -> Cmd Unit |] + Build -> [tyQ| {Cmd a} -> Cmd Actor |] + Drill -> [tyQ| Dir -> Cmd (Unit + Text) |] + Use -> [tyQ| Text -> Dir -> Cmd (Unit + Text) |] + Salvage -> [tyQ| Cmd Unit |] + Say -> [tyQ| Text -> Cmd Unit |] + Listen -> [tyQ| Cmd Text |] + Log -> [tyQ| Text -> Cmd Unit |] + View -> [tyQ| Actor -> Cmd Unit |] + Appear -> [tyQ| Text -> (Unit + Text) -> Cmd Unit |] + Create -> [tyQ| Text -> Cmd Unit |] + Halt -> [tyQ| Actor -> Cmd Unit |] + Time -> [tyQ| Cmd Int |] + Scout -> [tyQ| Dir -> Cmd Bool |] + Whereami -> [tyQ| Cmd (Int * Int) |] + Waypoint -> [tyQ| Text -> Int -> Cmd (Int * (Int * Int)) |] + Structure -> [tyQ| Text -> Int -> Cmd (Unit + (Int * (Int * Int))) |] + Floorplan -> [tyQ| Text -> Cmd (Int * Int) |] + HasTag -> [tyQ| Text -> Text -> Cmd Bool |] + TagMembers -> [tyQ| Text -> Int -> Cmd (Int * Text) |] + Detect -> [tyQ| Text -> ((Int * Int) * (Int * Int)) -> Cmd (Unit + (Int * Int)) |] + Resonate -> [tyQ| Text -> ((Int * Int) * (Int * Int)) -> Cmd Int |] + Density -> [tyQ| ((Int * Int) * (Int * Int)) -> Cmd Int |] + Sniff -> [tyQ| Text -> Cmd Int |] + Chirp -> [tyQ| Text -> Cmd Dir |] + Watch -> [tyQ| Dir -> Cmd Unit |] + Surveil -> [tyQ| (Int * Int) -> Cmd Unit |] + Heading -> [tyQ| Cmd Dir |] + Blocked -> [tyQ| Cmd Bool |] + Scan -> [tyQ| Dir -> Cmd (Unit + Text) |] + Upload -> [tyQ| Actor -> Cmd Unit |] + Ishere -> [tyQ| Text -> Cmd Bool |] + Isempty -> [tyQ| Cmd Bool |] + Self -> [tyQ| Actor |] + Parent -> [tyQ| Actor |] + Base -> [tyQ| Actor |] + Meet -> [tyQ| Cmd (Unit + Actor) |] + MeetAll -> [tyQ| (b -> Actor -> Cmd b) -> b -> Cmd b |] + Whoami -> [tyQ| Cmd Text |] + Setname -> [tyQ| Text -> Cmd Unit |] + Random -> [tyQ| Int -> Cmd Int |] + Run -> [tyQ| Text -> Cmd Unit |] + If -> [tyQ| Bool -> {a} -> {a} -> a |] Inl -> [tyQ| a -> a + b |] Inr -> [tyQ| b -> a + b |] Case -> [tyQ|a + b -> (a -> c) -> (b -> c) -> c |] Fst -> [tyQ| a * b -> a |] Snd -> [tyQ| a * b -> b |] Force -> [tyQ| {a} -> a |] - Return -> [tyQ| a -> cmd a |] - Try -> [tyQ| {cmd a} -> {cmd a} -> cmd a |] + Return -> [tyQ| a -> Cmd a |] + Try -> [tyQ| {Cmd a} -> {Cmd a} -> Cmd a |] Undefined -> [tyQ| a |] - Fail -> [tyQ| text -> a |] - Not -> [tyQ| bool -> bool |] - Neg -> [tyQ| int -> int |] + Fail -> [tyQ| Text -> a |] + Not -> [tyQ| Bool -> Bool |] + Neg -> [tyQ| Int -> Int |] Eq -> cmpBinT Neq -> cmpBinT Lt -> cmpBinT Gt -> cmpBinT Leq -> cmpBinT Geq -> cmpBinT - And -> [tyQ| bool -> bool -> bool|] - Or -> [tyQ| bool -> bool -> bool|] + And -> [tyQ| Bool -> Bool -> Bool|] + Or -> [tyQ| Bool -> Bool -> Bool|] Add -> arithBinT Sub -> arithBinT Mul -> arithBinT Div -> arithBinT Exp -> arithBinT - Format -> [tyQ| a -> text |] - Concat -> [tyQ| text -> text -> text |] - Chars -> [tyQ| text -> int |] - Split -> [tyQ| int -> text -> (text * text) |] - CharAt -> [tyQ| int -> text -> int |] - ToChar -> [tyQ| int -> text |] + Format -> [tyQ| a -> Text |] + Concat -> [tyQ| Text -> Text -> Text |] + Chars -> [tyQ| Text -> Int |] + Split -> [tyQ| Int -> Text -> (Text * Text) |] + CharAt -> [tyQ| Int -> Text -> Int |] + ToChar -> [tyQ| Int -> Text |] AppF -> [tyQ| (a -> b) -> a -> b |] - Swap -> [tyQ| text -> cmd text |] - Atomic -> [tyQ| cmd a -> cmd a |] - Instant -> [tyQ| cmd a -> cmd a |] - Key -> [tyQ| text -> key |] - InstallKeyHandler -> [tyQ| text -> (key -> cmd unit) -> cmd unit |] - Teleport -> [tyQ| actor -> (int * int) -> cmd unit |] - As -> [tyQ| actor -> {cmd a} -> cmd a |] - RobotNamed -> [tyQ| text -> cmd actor |] - RobotNumbered -> [tyQ| int -> cmd actor |] - Knows -> [tyQ| text -> cmd bool |] + Swap -> [tyQ| Text -> Cmd Text |] + Atomic -> [tyQ| Cmd a -> Cmd a |] + Instant -> [tyQ| Cmd a -> Cmd a |] + Key -> [tyQ| Text -> Key |] + InstallKeyHandler -> [tyQ| Text -> (Key -> Cmd Unit) -> Cmd Unit |] + Teleport -> [tyQ| Actor -> (Int * Int) -> Cmd Unit |] + As -> [tyQ| Actor -> {Cmd a} -> Cmd a |] + RobotNamed -> [tyQ| Text -> Cmd Actor |] + RobotNumbered -> [tyQ| Int -> Cmd Actor |] + Knows -> [tyQ| Text -> Cmd Bool |] where - cmpBinT = [tyQ| a -> a -> bool |] - arithBinT = [tyQ| int -> int -> int |] + cmpBinT = [tyQ| a -> a -> Bool |] + arithBinT = [tyQ| Int -> Int -> Int |] -- | @check t ty@ checks that @t@ has type @ty@, returning a -- type-annotated AST if so. @@ -937,7 +937,7 @@ check s@(CSyntax l t cs) expected = addLocToTypeErr l $ case t of case res of -- Generate a special error when the explicit type annotation -- on a lambda doesn't match the expected type, - -- e.g. (\x:int. x + 2) : text -> int, since the usual + -- e.g. (\x:Int. x + 2) : Text -> Int, since the usual -- "expected/but got" language would probably be confusing. Left _ -> throwTypeErr l $ LambdaArgMismatch (joined argTy xTy) Right _ -> return () @@ -947,7 +947,7 @@ check s@(CSyntax l t cs) expected = addLocToTypeErr l $ case t of -- Special case for checking the argument to 'atomic' (or -- 'instant'). 'atomic t' has the same type as 't', which must have - -- a type of the form 'cmd a' for some 'a'. + -- a type of the form 'Cmd a' for some 'a'. TConst c :$: at | c `elem` [Atomic, Instant] -> do @@ -1044,12 +1044,12 @@ check s@(CSyntax l t cs) expected = addLocToTypeErr l $ case t of -- | Ensure a term is a valid argument to @atomic@. Valid arguments -- may not contain @def@, @let@, or lambda. Any variables which are -- referenced must have a primitive, first-order type such as --- @text@ or @int@ (in particular, no functions, @cmd@, or +-- @Text@ or @Int@ (in particular, no functions, @Cmd@, or -- @delay@). We simply assume that any locally bound variables are -- OK without checking their type: the only way to bind a variable -- locally is with a binder of the form @x <- c1; c2@, where @c1@ is -- some primitive command (since we can't refer to external --- variables of type @cmd a@). If we wanted to do something more +-- variables of type @Cmd a@). If we wanted to do something more -- sophisticated with locally bound variables we would have to -- inline this analysis into typechecking proper, instead of having -- it be a separate, out-of-band check. diff --git a/src/swarm-lang/Swarm/Language/Types.hs b/src/swarm-lang/Swarm/Language/Types.hs index 5ce80830..0039f1d5 100644 --- a/src/swarm-lang/Swarm/Language/Types.hs +++ b/src/swarm-lang/Swarm/Language/Types.hs @@ -9,6 +9,7 @@ module Swarm.Language.Types ( -- * Basic definitions BaseTy (..), + baseTyName, Var, TypeF (..), @@ -115,7 +116,10 @@ data BaseTy BActor | -- | Keys, i.e. things that can be pressed on the keyboard BKey - deriving (Eq, Ord, Show, Data, Generic, FromJSON, ToJSON) + deriving (Eq, Ord, Show, Bounded, Enum, Data, Generic, FromJSON, ToJSON) + +baseTyName :: BaseTy -> Text +baseTyName = into @Text . drop 1 . show -- | A "structure functor" encoding the shape of type expressions. -- Actual types are then represented by taking a fixed point of this diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs index 36b0ea2f..2e617bb4 100644 --- a/src/swarm-tui/Swarm/TUI/Controller.hs +++ b/src/swarm-tui/Swarm/TUI/Controller.hs @@ -60,6 +60,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map qualified as M import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe) +import Data.Set qualified as S import Data.String (fromString) import Data.Text qualified as T import Data.Text.IO qualified as T @@ -1264,8 +1265,8 @@ tabComplete CompletionContext {..} names em theRepl = case theRepl ^. replPrompt possibleWords = names <> case ctxCreativeMode of - True -> reservedWords - False -> filter (`notElem` creativeWords) reservedWords + True -> S.toList reservedWords + False -> filter (`notElem` creativeWords) (S.toList reservedWords) entityNames = M.keys $ entitiesByName em diff --git a/test/bench/Benchmark.hs b/test/bench/Benchmark.hs index 5a451c79..2f903c84 100644 --- a/test/bench/Benchmark.hs +++ b/test/bench/Benchmark.hs @@ -63,7 +63,7 @@ treeProgram = moverProgram :: ProcessedTerm moverProgram = [tmQ| - let forever : cmd unit -> cmd unit = \c. c; forever c + let forever : Cmd Unit -> Cmd Unit = \c. c; forever c in forever move |] @@ -71,7 +71,7 @@ moverProgram = circlerProgram :: ProcessedTerm circlerProgram = [tmQ| - let forever : cmd unit -> cmd unit = \c. c; forever c + let forever : Cmd Unit -> Cmd Unit = \c. c; forever c in forever ( move; turn right; diff --git a/test/unit/TestEval.hs b/test/unit/TestEval.hs index 8067a898..591a85c9 100644 --- a/test/unit/TestEval.hs +++ b/test/unit/TestEval.hs @@ -133,13 +133,13 @@ testEval g = ("case (inr 2) (\\x. x + 1) (\\y. y * 17)" `evaluatesTo` VInt 34) , testCase "nested 1" - ("(\\x : int + bool + text. case x (\\q. 1) (\\s. case s (\\y. 2) (\\z. 3))) (inl 3)" `evaluatesTo` VInt 1) + ("(\\x : Int + Bool + Text. case x (\\q. 1) (\\s. case s (\\y. 2) (\\z. 3))) (inl 3)" `evaluatesTo` VInt 1) , testCase "nested 2" - ("(\\x : int + bool + text. case x (\\q. 1) (\\s. case s (\\y. 2) (\\z. 3))) (inr (inl false))" `evaluatesTo` VInt 2) + ("(\\x : Int + Bool + Text. case x (\\q. 1) (\\s. case s (\\y. 2) (\\z. 3))) (inr (inl false))" `evaluatesTo` VInt 2) , testCase "nested 2" - ("(\\x : int + bool + text. case x (\\q. 1) (\\s. case s (\\y. 2) (\\z. 3))) (inr (inr \"hi\"))" `evaluatesTo` VInt 3) + ("(\\x : Int + Bool + Text. case x (\\q. 1) (\\s. case s (\\y. 2) (\\z. 3))) (inr (inr \"hi\"))" `evaluatesTo` VInt 3) ] , testGroup "operator evaluation" @@ -295,7 +295,7 @@ testEval g = ("[y=1, x=3] < [x=3,y=0]" `evaluatesTo` VBool False) , testCase "record function" - ("let f : [x:int, y:text] -> int = \\r.r.x + 1 in f [x=3,y=\"hi\"]" `evaluatesTo` VInt 4) + ("let f : [x:Int, y:Text] -> Int = \\r.r.x + 1 in f [x=3,y=\"hi\"]" `evaluatesTo` VInt 4) , testCase "format record" ("format [y = 2, x = 1+2]" `evaluatesTo` VText "[x = 3, y = 2]") diff --git a/test/unit/TestLanguagePipeline.hs b/test/unit/TestLanguagePipeline.hs index 9484295e..dab2cd21 100644 --- a/test/unit/TestLanguagePipeline.hs +++ b/test/unit/TestLanguagePipeline.hs @@ -63,26 +63,74 @@ testLanguagePipeline = , testCase "parsing operators #239 - parse valid operator ($)" (valid "fst $ snd $ (1,2,3)") - , testCase - "Allow ' in variable names #269 - parse variable name containing '" - (valid "def a'_' = 0 end") - , testCase - "Allow ' in variable names #269 - do not parse variable starting with '" - ( process - "def 'a = 0 end" - ( T.unlines - [ "1:5:" - , " |" - , "1 | def 'a = 0 end" - , " | ^" - , "unexpected '''" - , "expecting variable name" - ] + , testGroup + "Identifiers" + [ testCase + "Allow ' in variable names #269 - parse variable name containing '" + (valid "def a'_' = 0 end") + , testCase + "Allow ' in variable names #269 - do not parse variable starting with '" + ( process + "def 'a = 0 end" + ( T.unlines + [ "1:5:" + , " |" + , "1 | def 'a = 0 end" + , " | ^" + , "unexpected '''" + , "expecting variable name" + ] + ) ) - ) + , testCase + "Disallow type name as variable name" + ( process + "let Int = 3 in Int + 1" + ( T.unlines + [ "1:8:" + , " |" + , "1 | let Int = 3 in Int + 1" + , " | ^" + , "Reserved word 'Int' cannot be used as a variable name" + ] + ) + ) + , testCase + "Allow uppercase term variable names" + (valid "let Is = 3 in Is + 1") + , testCase + "Disallow uppercase type variable names" + ( process + "def id : A -> A = \\x. x end" + ( T.unlines + [ "1:11:" + , " |" + , "1 | def id : A -> A = \\x. x end" + , " | ^" + , "Type variable names must start with a lowercase letter" + ] + ) + ) + , testCase + "Allow term variable names which are lowercase versions of reserved type names" + (valid "def idInt : Int -> Int = \\int. int end") + , testCase + "Disallow type variable names which are lowercase versions of reserved type names" + ( process + "def id : int -> int = \\x. x end" + ( T.unlines + [ "1:13:" + , " |" + , "1 | def id : int -> int = \\x. x end" + , " | ^" + , "Reserved type name 'int' cannot be used as a type variable name; perhaps you meant 'Int'?" + ] + ) + ) + ] , testCase "Parse pair syntax #225" - (valid "def f : (int -> bool) * (int -> bool) = (\\x. false, \\x. true) end") + (valid "def f : (Int -> Bool) * (Int -> Bool) = (\\x. false, \\x. true) end") , testCase "Nested pair syntax" (valid "(1,2,3,4)") @@ -95,19 +143,19 @@ testLanguagePipeline = "located type error" ( process "def a =\n 42 + \"oops\"\nend" - "2:7: Type mismatch:\n From context, expected `\"oops\"` to have type `int`,\n but it actually has type `text`" + "2:7: Type mismatch:\n From context, expected `\"oops\"` to have type `Int`,\n but it actually has type `Text`" ) , testCase "failure inside bind chain" ( process "move;\n1;\nmove" - "2:1: Type mismatch:\n From context, expected `1` to be a command,\n but it actually has type `int`" + "2:1: Type mismatch:\n From context, expected `1` to be a command,\n but it actually has type `Int`" ) , testCase "failure inside function call" ( process "if true \n{} \n(move)" - "3:1: Type mismatch:\n From context, expected `move` to have type `{cmd unit}`,\n but it actually has type `cmd unit`" + "3:1: Type mismatch:\n From context, expected `move` to have type `{Cmd Unit}`,\n but it actually has type `Cmd Unit`" ) , testCase "parsing operators #236 - report failure on invalid operator start" @@ -173,10 +221,10 @@ testLanguagePipeline = ) , testCase "grabif" - (valid "def grabif : text -> cmd unit = \\x. atomic (b <- ishere x; if b {grab; return ()} {}) end") + (valid "def grabif : Text -> Cmd Unit = \\x. atomic (b <- ishere x; if b {grab; return ()} {}) end") , testCase "placeif" - (valid "def placeif : text -> cmd bool = \\thing. atomic (res <- scan down; if (res == inl ()) {place thing; return true} {return false}) end") + (valid "def placeif : Text -> Cmd Bool = \\thing. atomic (res <- scan down; if (res == inl ()) {place thing; return true} {return false}) end") , testCase "atomic move+move" ( process @@ -193,7 +241,7 @@ testLanguagePipeline = "atomic non-simple" ( process "def dup = \\c. c; c end; atomic (dup (dup move))" - "1:33: Invalid atomic block: reference to variable with non-simple type ∀ a. cmd a -> cmd a: `dup`" + "1:33: Invalid atomic block: reference to variable with non-simple type ∀ a. Cmd a -> Cmd a: `dup`" ) , testCase "atomic nested" @@ -248,39 +296,39 @@ testLanguagePipeline = (process "0xabcD6G2" "1:8:\n |\n1 | 0xabcD6G2\n | ^\nunexpected 'G'\n") ] , testGroup - "void type" + "Void type" [ testCase "isSimpleUType" ( assertBool "" $ isSimpleUType UTyVoid ) , testCase "valid type signature" - (valid "def f : void -> a = \\x. undefined end") + (valid "def f : Void -> a = \\x. undefined end") ] , testGroup "record type" [ testCase "valid record" - (valid "\\x:int. ([y = \"hi\", x, z = \\x.x] : [x:int, y:text, z:bool -> bool])") + (valid "\\x:Int. ([y = \"hi\", x, z = \\x.x] : [x:Int, y:Text, z:Bool -> Bool])") , testCase "infer record type" (valid "[x = 3, y = \"hi\"]") , testCase "field mismatch - missing" ( process - "(\\r:[x:int, y:int]. r.x) [x = 3]" + "(\\r:[x:Int, y:Int]. r.x) [x = 3]" "1:26: Field mismatch; record literal has:\n - Missing field(s) `y`" ) , testCase "field mismatch - extra" ( process - "(\\r:[x:int, y:int]. r.x) [x = 3, y = 4, z = 5]" + "(\\r:[x:Int, y:Int]. r.x) [x = 3, y = 4, z = 5]" "1:26: Field mismatch; record literal has:\n - Extra field(s) `z`" ) , testCase "field mismatch - both" ( process - "(\\r:[x:int, y:int]. r.x) [x = 3, z = 5]" + "(\\r:[x:Int, y:Int]. r.x) [x = 3, z = 5]" "1:26: Field mismatch; record literal has:\n - Extra field(s) `z`\n - Missing field(s) `y`" ) ] @@ -291,13 +339,13 @@ testLanguagePipeline = ( assertEqual "type annotations" (toListOf traverse (getSyntax [tmQ| 1 + 1 |])) - [[tyQ| int -> int -> int|], [tyQ|int|], [tyQ|int -> int|], [tyQ|int|], [tyQ|int|]] + [[tyQ| Int -> Int -> Int|], [tyQ|Int|], [tyQ|Int -> Int|], [tyQ|Int|], [tyQ|Int|]] ) , testCase "get all annotated variable types" ( let s = getSyntax - [tmQ| def f : (int -> int) -> int -> text = \g. \x. format (g x) end |] + [tmQ| def f : (Int -> Int) -> Int -> Text = \g. \x. format (g x) end |] isVar (TVar {}) = True isVar _ = False @@ -305,25 +353,25 @@ testLanguagePipeline = in assertEqual "variable types" (getVars s) - [ (TVar "g", [tyQ| int -> int |]) - , (TVar "x", [tyQ| int |]) + [ (TVar "g", [tyQ| Int -> Int |]) + , (TVar "x", [tyQ| Int |]) ] ) , testCase "simple type ascription" - (valid "(3 : int) + 5") + (valid "(3 : Int) + 5") , testCase "invalid type ascription" - (process "1 : text" "1:1: Type mismatch:\n From context, expected `1` to have type `text`,\n but it actually has type `int`") + (process "1 : Text" "1:1: Type mismatch:\n From context, expected `1` to have type `Text`,\n but it actually has type `Int`") , testCase "type ascription with a polytype" (valid "((\\x . x) : a -> a) 3") , testCase "type ascription too general" - (process "1 : a" "1:1: Type mismatch:\n From context, expected `1` to have type `s0`,\n but it actually has type `int`") + (process "1 : a" "1:1: Type mismatch:\n From context, expected `1` to have type `s0`,\n but it actually has type `Int`") , testCase "type specialization through type ascription" - (valid "fst:(int + b) * a -> int + b") + (valid "fst:(Int + b) * a -> Int + b") , testCase "type ascription doesn't allow rank 2 types" ( process @@ -333,8 +381,8 @@ testLanguagePipeline = , testCase "checking a lambda with the wrong argument type" ( process - "(\\x:int. x + 2) : text -> int" - "1:1: Lambda argument has type annotation `int`, but expected argument type `text`" + "(\\x:Int. x + 2) : Text -> Int" + "1:1: Lambda argument has type annotation `Int`, but expected argument type `Text`" ) ] , testGroup @@ -348,38 +396,38 @@ testLanguagePipeline = , testCase "providing a pair as an argument" ( process - "(\\x:int. x + 1) (1,2)" - "1:17: Type mismatch:\n From context, expected `(1, 2)` to have type `int`,\n but it is actually a pair" + "(\\x:Int. x + 1) (1,2)" + "1:17: Type mismatch:\n From context, expected `(1, 2)` to have type `Int`,\n but it is actually a pair" ) , testCase "mismatched if branches" ( process "if true {grab} {}" - "1:16: Type mismatch:\n From context, expected `noop` to have type `cmd text`,\n but it actually has type `cmd unit`" + "1:16: Type mismatch:\n From context, expected `noop` to have type `Cmd Text`,\n but it actually has type `Cmd Unit`" ) , testCase "definition with wrong result" ( process - "def m : int -> int -> int = \\x. \\y. {3} end" - "1:37: Type mismatch:\n From context, expected `{3}` to have type `int`,\n but it is actually a delayed expression\n\n - While checking the definition of m" + "def m : Int -> Int -> Int = \\x. \\y. {3} end" + "1:37: Type mismatch:\n From context, expected `{3}` to have type `Int`,\n but it is actually a delayed expression\n\n - While checking the definition of m" ) , testCase "comparing two incompatible functions" ( process - "(\\f:int -> text. f 3) (\\x:int. 3)" - "1:32: Type mismatch:\n From context, expected `3` to have type `text`,\n but it actually has type `int`\n" + "(\\f:Int -> Text. f 3) (\\x:Int. 3)" + "1:32: Type mismatch:\n From context, expected `3` to have type `Text`,\n but it actually has type `Int`\n" ) , testCase "comparing two incompatible functions 2" ( process - "(\\f:int -> text. f 3) (\\x:int. \\y:int. \"hi\")" - "1:32: Type mismatch:\n From context, expected `\\y:int. \"hi\"` to have type `text`,\n but it is actually a function\n" + "(\\f:Int -> Text. f 3) (\\x:Int. \\y:Int. \"hi\")" + "1:32: Type mismatch:\n From context, expected `\\y:Int. \"hi\"` to have type `Text`,\n but it is actually a function\n" ) , testCase - "unify two-argument function and int" + "unify two-argument function and Int" ( process "1 + (\\x. \\y. 3)" - "1:5: Type mismatch:\n From context, expected `\\x. \\y. 3` to have type `int`,\n but it is actually a function\n" + "1:5: Type mismatch:\n From context, expected `\\x. \\y. 3` to have type `Int`,\n but it is actually a function\n" ) ] , testGroup @@ -392,7 +440,7 @@ testLanguagePipeline = (valid "f <- return (\\x.x); return (f 3, f \"hi\")") , testCase "local bind is polymorphic" - (valid "def foo : cmd (int * text) = f <- return (\\x.x); return (f 3, f \"hi\") end") + (valid "def foo : Cmd (Int * Text) = f <- return (\\x.x); return (f 3, f \"hi\") end") ] ] where diff --git a/test/unit/TestPretty.hs b/test/unit/TestPretty.hs index 5e21e58b..7b98ae76 100644 --- a/test/unit/TestPretty.hs +++ b/test/unit/TestPretty.hs @@ -87,12 +87,12 @@ testPrettyConst = TPair (TInt 1) (TPair (TInt 2) (TInt 3)) ) , testCase - "void type" - ( assertEqual "" "void" . show $ ppr TyVoid + "Void type" + ( assertEqual "" "Void" . show $ ppr TyVoid ) , testCase "type ascription" - ( equalPretty "1 : int" $ + ( equalPretty "1 : Int" $ TAnnotate (TInt 1) (Forall [] TyInt) ) , testCase diff --git a/test/unit/TestRepl.hs b/test/unit/TestRepl.hs index 9fd9c667..60f8e76b 100644 --- a/test/unit/TestRepl.hs +++ b/test/unit/TestRepl.hs @@ -33,15 +33,15 @@ testRepl = , testCase "latest repl lines after one input and output" ( assertEqual - "get 5 history [0|1,1:int] --> [1,1:int]" - [REPLEntry "1", REPLOutput "1:int"] + "get 5 history [0|1,1:Int] --> [1,1:Int]" + [REPLEntry "1", REPLOutput "1:Int"] (getLatestREPLHistoryItems 5 (addInOutInt 1 history0)) ) , testCase "latest repl lines after nine inputs and outputs" ( assertEqual - "get 6 history [0|1,1:int .. 9,9:int] --> [7,7:int..9,9:int]" - (concat [[REPLEntry (toT x), REPLOutput (toT x <> ":int")] | x <- [7 .. 9]]) + "get 6 history [0|1,1:Int .. 9,9:Int] --> [7,7:Int..9,9:Int]" + (concat [[REPLEntry (toT x), REPLOutput (toT x <> ":Int")] | x <- [7 .. 9]]) (getLatestREPLHistoryItems 6 (foldl (flip addInOutInt) history0 [1 .. 9])) ) , testCase @@ -71,14 +71,14 @@ testRepl = , testCase "current item after move past output" ( assertEqual - "getText ([0,1,1:int]<=='') --> Just 1" + "getText ([0,1,1:Int]<=='') --> Just 1" (Just "1") (getCurrentItemText $ moveReplHistIndex Older "" (addInOutInt 1 history0)) ) , testCase "current item after move past same" ( assertEqual - "getText ([0,1,1:int]<=='1') --> Just 0" + "getText ([0,1,1:Int]<=='1') --> Just 0" (Just "0") (getCurrentItemText $ moveReplHistIndex Older "1" (addInOutInt 1 history0)) ) @@ -88,4 +88,4 @@ testRepl = toT :: Int -> Text toT = fromString . show addInOutInt :: Int -> REPLHistory -> REPLHistory - addInOutInt i = addREPLItem (REPLOutput $ toT i <> ":int") . addREPLItem (REPLEntry $ toT i) + addInOutInt i = addREPLItem (REPLOutput $ toT i <> ":Int") . addREPLItem (REPLEntry $ toT i)