flp (empty) → 0.1.0.0
raw patch · 61 files changed
+12476/−0 lines, 61 filesdep +HUnitdep +arraydep +base
Dependencies added: HUnit, array, base, containers, deepseq, flp, haskell-src-meta, pretty-simple, prettyprinter, template-haskell, test-framework, test-framework-hunit, th-lift, transformers
Files
- ChangeLog.md +3/−0
- LICENSE +23/−0
- LICENSE.language-rust +30/−0
- README.md +81/−0
- app/floorplan.hs +50/−0
- app/semantics.hs +177/−0
- examples/app.flp +8/−0
- examples/arith.flp +4/−0
- examples/arith_id.flp +7/−0
- examples/arith_power.flp +7/−0
- examples/bits.flp +9/−0
- examples/bump.flp +12/−0
- examples/dyn_choice.flp +7/−0
- examples/dyn_seq.flp +7/−0
- examples/dynamic_prim.flp +7/−0
- examples/empty.flp +6/−0
- examples/enum.flp +7/−0
- examples/enum_bad0.flp +7/−0
- examples/layer.flp +7/−0
- examples/map_bits.flp +7/−0
- examples/named_ref.flp +11/−0
- examples/nested.flp +8/−0
- examples/nested_union.flp +10/−0
- examples/parens.flp +5/−0
- examples/seq.flp +7/−0
- examples/union.flp +7/−0
- examples/uniq_fail.flp +13/−0
- flp.cabal +157/−0
- src/Language/Floorplan.hs +9/−0
- src/Language/Floorplan/Core/Compiler.hs +171/−0
- src/Language/Floorplan/Core/Syntax.hs +114/−0
- src/Language/Floorplan/Parser.y +188/−0
- src/Language/Floorplan/Rust.hs +5/−0
- src/Language/Floorplan/Rust/Common.hs +170/−0
- src/Language/Floorplan/Rust/Compiler.hs +908/−0
- src/Language/Floorplan/Rust/Mapping.hs +227/−0
- src/Language/Floorplan/Rust/Types.hs +24/−0
- src/Language/Floorplan/Semantics.hs +67/−0
- src/Language/Floorplan/Syntax.hs +141/−0
- src/Language/Floorplan/Token.x +95/−0
- src/Language/Rust/Data/Ident.hs +94/−0
- src/Language/Rust/Data/InputStream.hs +170/−0
- src/Language/Rust/Data/Position.hs +220/−0
- src/Language/Rust/Parser.hs +153/−0
- src/Language/Rust/Parser/Internal.y +2123/−0
- src/Language/Rust/Parser/Lexer.x +1321/−0
- src/Language/Rust/Parser/Literals.hs +130/−0
- src/Language/Rust/Parser/NonEmpty.hs +80/−0
- src/Language/Rust/Parser/ParseMonad.hs +170/−0
- src/Language/Rust/Parser/Reversed.hs +86/−0
- src/Language/Rust/Pretty.hs +238/−0
- src/Language/Rust/Pretty/Internal.hs +1030/−0
- src/Language/Rust/Pretty/Literals.hs +138/−0
- src/Language/Rust/Pretty/Resolve.hs +1515/−0
- src/Language/Rust/Pretty/Util.hs +161/−0
- src/Language/Rust/Quote.hs +232/−0
- src/Language/Rust/Syntax.hs +29/−0
- src/Language/Rust/Syntax/AST.hs +1206/−0
- src/Language/Rust/Syntax/Token.hs +376/−0
- src/Language/Rust/Syntax/Token.hs-boot +38/−0
- test/parser/Main.hs +163/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for flp++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,23 @@+The code in floorplan is released under the license below.++The MIT License (MIT)++Copyright (c) 2019,2020 Karl Cronburg. All rights reserved.++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ LICENSE.language-rust view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Alec Theriault++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Alec Theriault nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,81 @@+# Floorplan compiler++A language for specifying the layout of a one-dimensional address space, particularly+for garbage collectors and manual memory managers written in Rust.++## Building and running++Floorplan is written in Haskell and must be [built with stack](https://docs.haskellstack.org/en/stable/README/).+Once you have stack installed on your system, you should be able to run the build+command and everything should just work:++```bash+$ stack build+...+Completed 2 action(s).+```++At which point you can compile the file `examples/immix/layout.flp` with+the `build-immix` script:++```bash+$ ./build-immix+...+ Compiling immix_rust v0.0.1 (/home/karl/w/flp/examples/immix)+ Finished dev [unoptimized + debuginfo] target(s) in 4.56s+```++This script ensures the Floorplan compiler is built, installs it for your current+user, and then builds the Immix project which itself invokes the Floorplan compiler+to build the file `examples/immix/src/heap/layout.flp`.++In order to run the compiler against some other `.flp` file, the compiler can+be run directly as follows:++```bash+stack exec flp [path/to/layout.flp] [path/to/generated.rs]+```++Note that in order to subsequently build a Rust file generated in this manner,+you must include the `flp-framework` to your Cargo dependencies, and `flp-compiler`+to your cargo build-dependencies. The later is simply a wrapper for calling out+to the (already stack-installed) flp compiler, and the framework crate contains+necessary macros and address types that generated Rust code uses.++The skeleton of a Rust cargo project is given in the `gen/` directory of this+repo, which can be copied over and modified to support the needs of a memory+manager other than immix-rust.++## Dependencies++A customized version of the [language-rust](https://github.com/harpocrates/language-rust)+package is included in the `deps/` directory of this repo, which adds support for+directly splicing of host language expressions into quasiquoted Rust code. This is the+mechanism by which Floorplan generates Rust code.++## Testing and contributing++If you want to help maintain or contribute new code to this project, feel free to+make a pull request or better yet start an issue in the the Issues tracker so that+you can get our feedback along the way. A number of avenues for work on the compiler+exist, including but not limited to:++- More example Rust allocators implemented with a Floorplan layout.+- Rust templates for allocating on alignment boundaries.+- Extensively document the interfaces generated.+- Better error messages.+- Integrating the core semantics (`app/semantics.hs`) directly into the project+ `src/` hierarchy.+- Calling out to a SMT library to verify alignment and size constraints.+- Targeting both C and Rust.+- Support for non-64-bit architectures.+- Generating debugging assertions.+- Dynamic tracking of type information for each piece of the heap.+- Cleaning up the dependencies by integrating the Rust splicing support directly+ into [the upstream repository](https://github.com/harpocrates/language-rust),+ e.g. as a separate quasiquoter.+- Generate cargo-based Rust documentation alongside generated functions, indicating+ why a certain function was generated and how it might be used.+- Repairing the Coq proofs in the `proofs/*.v` files.+- Better Rust integration and downstream crates.+
+ app/floorplan.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+module Main where+import Prelude hiding (putStrLn)+import qualified Prelude as P+import System.Environment+import System.IO hiding (putStr, putStrLn, hGetLine)+import System.Exit (exitSuccess, exitFailure)+import Control.Exception (assert)++import Language.Rust.Syntax (SourceFile(..))+import Language.Rust.Data.Position (Span(..))+import Language.Rust.Pretty (pretty')++import Language.Floorplan+import qualified Language.Floorplan.Rust.Compiler as RC++--import qualified Language.Floorplan.Parser as P+import qualified Language.Floorplan.Parser as P+import qualified Language.Floorplan.Syntax as S+import qualified Language.Floorplan.Core.Compiler as CC+import qualified Language.Floorplan.Core.Syntax as CS++usage = do+ pName <- getProgName+ P.putStrLn $ pName ++ " [file.flp] [path/to/dest.rs]"++doResult :: String -> FilePath -> [Demarc] -> IO ()+doResult compiler outDir result = do+ let grafted :: [S.Demarc] = map (CC.grafting result) result+ core_flp :: [CS.BaseExp] = map CC.compile grafted+ sf :: SourceFile Span = RC.genRust core_flp+ --print $ pretty' sf+ assert ((CC.countGrafting grafted) == 0) (return ())+ case compiler of+ "rust" -> (RC.writeModule outDir) sf+ _ -> usage+ exitSuccess++oops s = P.putStr s >> exitFailure++main = do+ args <- getArgs+ case args of+ (flpFile : outDir : rst) ->+ do contents <- readFile flpFile+ let r = P.parseLayers contents+ doResult "rust" outDir r+ _ -> usage++
+ app/semantics.hs view
@@ -0,0 +1,177 @@+import Data.Maybe (fromJust)+import Text.Pretty.Simple (pPrint)+import System.Environment+import System.IO hiding (putStr, putStrLn, hGetLine)+import System.Exit (exitSuccess, exitFailure)+import Control.Exception (assert)++--import Language.Rust.Syntax (SourceFile(..))+--import Language.Rust.Data.Position (Span(..))+--import Language.Rust.Pretty (pretty')+--+--import Language.Floorplan+--import qualified Language.Floorplan.Parser as P+--import qualified Language.Floorplan.Syntax as S+--import qualified Language.Floorplan.Core.Compiler as CC+--import qualified Language.Floorplan.Core.Syntax as CS++type LayerID = String+type FormalID = String+type FieldID = String+type FlagID = String++ex_code :: Demarc+ex_code = Layer "K" ["n"] (Just $ PrimOp (Just $ LitInt 5) BytesTy) Nothing $+ Seq [ Field "hd" $ Count "n" (Size $ PrimOp (Just $ LitInt 1) BytesTy)+ , Field "tl" $ Count "n" $+ Seq [ Field "lft" $ Size $ PrimOp (Just $ LitInt 1) BytesTy+ , Field "rgt" $ Hash (Size $ PrimOp Nothing BytesTy)+ ]+ ]++data DemarcVal =+ Hash DemarcVal+ | Count FormalID DemarcVal+ | Seq [Demarc]+ | Union [Demarc]+ | Ptr (Either LayerID FieldID)+ | Enum [FlagID]+ | Bits [BitsExp]+ | Size SizeArith+ deriving (Eq, Ord, Show)++type Mag = SizeArith+type Align = SizeArith++data Demarc =+ Field FieldID DemarcVal+ | Layer LayerID [FormalID] (Maybe Mag) (Maybe Align) DemarcVal+ | DV DemarcVal+ deriving (Eq, Ord, Show)++type BitsExp = (FieldID, SizeArith)++data PrimTy = BitsTy | BytesTy | WordsTy | PagesTy+ deriving (Eq, Ord, Show)++data SizeArith =+ PrimOp (Maybe LitArith) PrimTy+ | SizePlus SizeArith SizeArith+ | SizeMinus SizeArith SizeArith+ deriving (Eq, Ord, Show)++data LitArith =+ LitBin Int+ | LitInt Int+ | LitPlus LitArith LitArith+ | LitMinus LitArith LitArith+ | LitTimes LitArith LitArith+ | LitDiv LitArith LitArith+ | LitExponent LitArith LitArith+ deriving (Eq, Ord, Show)++data Exp =+ Plus Exp Exp+ | Or Exp Exp+ | Prim Int+ | Con Int Exp+ | HasType String Exp+ | Exists String Exp+ | Pound String Exp+ | Align Exp Int+ deriving (Eq, Ord, Show)++data Tree =+ T Tree Tree+ | N String Tree+ | B0 | B1+ deriving (Eq, Ord, Show)++-- Compilation rules. TODO: f_0!!!+cV :: DemarcVal -> Exp+cV (Hash dv) = Exists "f_0" (Pound "f_0" (cV dv))+cV (Count f_0 dv) = Pound f_0 (cV dv)+cV (Seq (d:ds)) = foldl Plus (c d) (map c ds)+cV (Union (d:ds)) = foldl Or (c d) (map c ds)+cV (Ptr id) = Prim 8+cV (Enum fs) = undefined+cV (Bits bes) = undefined+cV (Size sa) = Prim 1 -- TODO: Prim 1!++formals :: [FormalID] -> Exp -> Exp+formals (f:fs) e = Exists f (formals fs e)+formals [] e = e++-- TODO: Con 5! Align error!+c :: Demarc -> Exp+c (Field f dv) = HasType f (cV dv)+c (Layer lid fs Nothing Nothing dv) = HasType lid $ formals fs $ cV dv+c (Layer lid fs (Just mag) Nothing dv) = HasType lid $ formals fs $ Con 5 $ cV dv+c (Layer lid fs Nothing (Just aln) dv) = HasType lid $ formals fs $ Align (cV dv) (error "TODO")+c (Layer lid fs (Just mag) (Just aln) dv) = HasType lid $ formals fs $ Con 5 $ Align (cV dv) (error "TODO")+c (DV dv) = cV dv++d0 = g 0 5 [] (Prim 5)+d1 = addStep ("Choose m=5") $ g 0 5 [] $+ HasType "K" $ Exists "n" $ Con 5 $ Plus+ (HasType "hd" $ Pound "n" $ Prim 1)+ $ HasType "tl" $ Pound "n" $ Plus+ (HasType "lft" (Prim 1))+ (HasType "rgt" (Exists "f_1" $ Pound "f_1" $ Prim 1))++leaves (T t1 t2) = leaves t1 + leaves t2+leaves (N _ t) = leaves t+leaves B0 = 0+leaves B1 = 1++addStep s xs = map (\(r,d) -> (r, s : d)) xs++-- Gamma+g p0 p1 p2 p3 = let+ g' a m theta (Plus e1 e2) =+ let params = \r1 -> (a + leaves r1, m - leaves r1, theta, e2)+ in+ [ (T r1 r2, ("Plus: i = 0.." ++ show m ++ ", Pause (g " ++ show (params r1) ++ ")") : deriv1+ ++ ["Resume (g " ++ show (params r1) ++ ")" ++ ", leaves r1 = " ++ show (leaves r1)] ++ deriv2)+ | (r1, deriv1) <- concat [ addStep ("Plus_r1: Choose i=" ++ show i) $ g a i theta e1 | i <- [0..m]]+ , (r2, deriv2) <- addStep ("Plus_r2: leaves(" ++ show e1 ++ ")=" ++ show (leaves r1)) $ g (a + leaves r1) (m - leaves r1) theta e2+ ]+ g' a m theta (Or _ _) = error "nope"+ g' a m theta (Prim n)+ | m == n = [(foldl T B0 (take n $ repeat B1), ["Prim: Evaluate " ++ show n ++ "-leaf tree"])]+ | otherwise = []+ g' a m theta (Con n e)+ | m == n = addStep ("Con: " ++ show n) (g a m theta e)+ | m /= n = []+ g' a m theta (Align e aln) = undefined+ g' a m theta (HasType l e) =+ [ (N l r, ("HasType: " ++ l) : deriv)+ | (r, deriv) <- g a m theta e+ ]+ g' a m theta (Exists f e) = concat+ [ addStep ("Exists: Choose " ++ f ++ "=" ++ show i)+ $ g a m ((f, i) : theta) e | i <- [0 .. m] ]+ g' a m theta (Pound f e)+ | (Just m) == lookup f theta && m == 0 = [(T B0 B0, ["Pound: m = 0"])]+ | (Just 0) == lookup f theta = []+ | otherwise = let -- Implies lookup theta f > 0+ params = \r1 -> (a + leaves r1, m - leaves r1, (f, (fromJust $ lookup f theta) - 1) : theta, Pound f e)+ in case lookup f theta of+ Nothing -> error "Nothing"+ Just thetaF -> [ (T r1 r2, ("Pound: theta(" ++ f ++ ")=" ++ show thetaF ++ ", Pause (g " ++ show (params r1)) : deriv1+ ++ ["Resume (g " ++ show (params r1) ++ ")"] ++ deriv2)+ | (r1, deriv1) <- concat [addStep ("Pound_r1: Choose i=" ++ show i) $ g a i theta e | i <- [0..m]]+ , (r2, deriv2) <- addStep ("Pound_r2: leaves(" ++ show e ++ ")=" ++ show (leaves r1)) $+ g (a + leaves r1) (m - leaves r1) ((f, (fromJust $ lookup f theta) - 1) : theta) (Pound f e)+ ]++ addLabel (r, d:ds) = (r, (d ++ "[[g " ++ show (p0, p1, p2, p3) ++ "]] ") : ds)++ in map addLabel (g' p0 p1 p2 p3)++main = do+ args <- getArgs+ case args of+ (flpFile : rest) -> undefined+ _ -> pPrint d1+
+ examples/app.flp view
@@ -0,0 +1,8 @@+// Parser test: nested groups (union and seq) with+// fixed-width fields.++Block -> union {+ A -> seq { a : Cell<$ 0 $>, b : 2 words }+ | B -> seq { a : 0 words, c : 2 words }+}+
+ examples/arith.flp view
@@ -0,0 +1,4 @@+// Parser test++Arith ||7 bytes|| -> (4 / 2 * 3 + 1) bytes+
+ examples/arith_id.flp view
@@ -0,0 +1,7 @@+// Parser test: arithmetic expressions with identifiers++Block<n, k> -> union {+ A -> seq { a : 0 words, b : n words }+ | B -> seq { a : n words, c : k words }+}+
+ examples/arith_power.flp view
@@ -0,0 +1,7 @@+// Parser test: exponentiation in arithmetic inside a field.++Block -> union {+ A -> seq { a : 0 words, b : 2^2 words }+ | B -> seq { a : 0 words, c : 2^4 words }+}+
+ examples/bits.flp view
@@ -0,0 +1,9 @@+// Parser test++RefBits -> bits {+ SHORT_ENCODE : 1 bits,+ OBJ_START : 1 bits,+ REF : 6 bits,+ MORE : (2 + 2) bits + 4 bits+}+
+ examples/bump.flp view
@@ -0,0 +1,12 @@++Bump ||2^16 bytes|| @(2^16 bytes)@ -> seq {+ union {+ Partial ||7 * 2^13 bytes|| @(2^13 bytes)@ -> seq {+ cells : # Cell,+ cursor : # words,+ limit : 0 words+ }+ | # Allocd -> 1 words+ }+}+
+ examples/dyn_choice.flp view
@@ -0,0 +1,7 @@+// Parser test: dynamic union of two fixed-width fields.++Union ||2 bytes|| @(2 bytes)@ -> # union {+ a : 1 bytes+ | b : 1 bytes+}+
+ examples/dyn_seq.flp view
@@ -0,0 +1,7 @@+// Parser test: dynamic sequence with fixed-width fields.++Seq ||2 bytes|| @(2 bytes)@ -> # seq {+ a : 1 bytes,+ b : 1 bytes+}+
+ examples/dynamic_prim.flp view
@@ -0,0 +1,7 @@+// Parser test: dynamic primitive in arithmetic++Seq -> seq {+ a : # bytes,+ b : 1 bytes+}+
+ examples/empty.flp view
@@ -0,0 +1,6 @@+// Mostly empty file++// Ok.++Foo -> Bar+
+ examples/enum.flp view
@@ -0,0 +1,7 @@+// Parser test: basic enum++LineMark -> enum {+ Free | Live | FreshAlloc+ | ConservLive | PrevLive+}+
+ examples/enum_bad0.flp view
@@ -0,0 +1,7 @@+// Parser test: basic enum failure due to lower-case ID (prevLive)++LineMark -> enum {+ Free | Live | FreshAlloc+ | ConservLive | prevLive+}+
+ examples/layer.flp view
@@ -0,0 +1,7 @@+// Parser test++Seq -> seq {+ Oops -> Bar,+ Foo -> Baz ptr+}+
+ examples/map_bits.flp view
@@ -0,0 +1,7 @@+// Compiler test: mapping bits to bits code gen++Foo<count> -> seq {+ count bytes,+ count Bar ||2 bytes|| -> 2 bytes+}+
+ examples/named_ref.flp view
@@ -0,0 +1,11 @@+// Parser test: a named reference to a flp type specified elsewhere++Seq -> seq {+ a : # A,+ b : B+}++A -> 1 words++B -> 2 bytes+
+ examples/nested.flp view
@@ -0,0 +1,8 @@+// Parser test: nested groups (union and seq) with+// fixed-width fields.++Block -> union {+ A -> seq { a : 0 words, b : 2 words }+ | B -> seq { a : 0 words, c : 2 words }+}+
+ examples/nested_union.flp view
@@ -0,0 +1,10 @@+// Parser test: union in various places (both in a flake and in a field)++Block -> union {+ A -> seq {+ a : union { 1 words | 1 words }+ , b : 2^2 words+ }+ | B -> seq { a : 0 words, c : (2^4) words }+}+
+ examples/parens.flp view
@@ -0,0 +1,5 @@++Bar -> 1 words - 1 bytes++Foo -> (1 words - 1 bytes)+
+ examples/seq.flp view
@@ -0,0 +1,7 @@+// Parser test: basic sequence with fixed-width fields.++Seq -> seq {+ a : Oops,+ b : Oops ptr+}+
+ examples/union.flp view
@@ -0,0 +1,7 @@+// Parser test: basic union test.++Union -> union {+ Oops+ | Oops ptr+}+
+ examples/uniq_fail.flp view
@@ -0,0 +1,13 @@++Outer -> seq {+ foo : 1 words,+ bar : 2 words,+ Inner -> seq {+ Outer -> 2 words+ }+}++Other -> seq {+ foo : 2 words+}+
+ flp.cabal view
@@ -0,0 +1,157 @@+cabal-version: 1.12+name: flp+version: 0.1.0.0+license: MIT+license-file: LICENSE+copyright: 2019 Karl Cronburg+maintainer: karl@cs.tufts.edu+author: Karl Cronburg+homepage: https://github.com/RedlineResearch/floorplan#readme+bug-reports: https://github.com/RedlineResearch/floorplan/issues+synopsis: A layout spec language for memory managers implemented in Rust.+description:+ Please see the README on GitHub at <https://github.com/cronburg/flp#readme>+category: Compiler+build-type: Simple+extra-source-files:+ README.md+ LICENSE+ LICENSE.language-rust+ ChangeLog.md+ examples/app.flp+ examples/arith.flp+ examples/arith_id.flp+ examples/arith_power.flp+ examples/bits.flp+ examples/bump.flp+ examples/dynamic_prim.flp+ examples/dyn_choice.flp+ examples/dyn_seq.flp+ examples/empty.flp+ examples/enum_bad0.flp+ examples/enum.flp+ examples/layer.flp+ examples/map_bits.flp+ examples/named_ref.flp+ examples/nested.flp+ examples/nested_union.flp+ examples/parens.flp+ examples/seq.flp+ examples/union.flp+ examples/uniq_fail.flp++source-repository head+ type: git+ location: https://github.com/RedlineResearch/floorplan++library+ exposed-modules:+ Language.Floorplan+ Language.Floorplan.Core.Compiler+ Language.Floorplan.Core.Syntax+ Language.Floorplan.Parser+ Language.Floorplan.Rust+ Language.Floorplan.Rust.Common+ Language.Floorplan.Rust.Compiler+ Language.Floorplan.Rust.Mapping+ Language.Floorplan.Rust.Types+ Language.Floorplan.Semantics+ Language.Floorplan.Syntax+ Language.Floorplan.Token+ Language.Rust.Data.Ident+ Language.Rust.Data.InputStream+ Language.Rust.Data.Position+ Language.Rust.Parser+ Language.Rust.Parser.Internal+ Language.Rust.Parser.Lexer+ Language.Rust.Parser.Literals+ Language.Rust.Parser.NonEmpty+ Language.Rust.Parser.ParseMonad+ Language.Rust.Parser.Reversed+ Language.Rust.Pretty+ Language.Rust.Pretty.Internal+ Language.Rust.Pretty.Literals+ Language.Rust.Pretty.Resolve+ Language.Rust.Pretty.Util+ Language.Rust.Quote+ Language.Rust.Syntax+ Language.Rust.Syntax.AST+ Language.Rust.Syntax.Token+ build-tools: alex -any, happy -any+ hs-source-dirs: src+ other-modules:+ Paths_flp+ default-language: Haskell2010+ build-depends:+ array >=0.5.3.0 && <0.6,+ base >=4.7 && <5,+ containers >=0.6.0.1 && <0.7,+ deepseq >=1.4.4.0 && <1.5,+ haskell-src-meta >=0.8.3 && <0.9,+ prettyprinter >=1.2.1.1 && <1.3,+ template-haskell >=2.14.0.0 && <2.15,+ th-lift >=0.8.1 && <0.9,+ transformers >=0.5.6.2 && <0.6++executable flp+ main-is: floorplan.hs+ build-tools: alex -any, happy -any+ hs-source-dirs: app+ other-modules:+ Paths_flp+ default-language: Haskell2010+ build-depends:+ array >=0.5.3.0 && <0.6,+ base >=4.7 && <5,+ containers >=0.6.0.1 && <0.7,+ deepseq >=1.4.4.0 && <1.5,+ flp -any,+ haskell-src-meta >=0.8.3 && <0.9,+ prettyprinter >=1.2.1.1 && <1.3,+ template-haskell >=2.14.0.0 && <2.15,+ th-lift >=0.8.1 && <0.9,+ transformers >=0.5.6.2 && <0.6++executable sem+ main-is: semantics.hs+ build-tools: alex -any, happy -any+ hs-source-dirs: app+ other-modules:+ Paths_flp+ default-language: Haskell2010+ build-depends:+ array >=0.5.3.0 && <0.6,+ base >=4.7 && <5,+ containers >=0.6.0.1 && <0.7,+ deepseq >=1.4.4.0 && <1.5,+ flp -any,+ haskell-src-meta >=0.8.3 && <0.9,+ pretty-simple >=2.2.0.1 && <2.3,+ prettyprinter >=1.2.1.1 && <1.3,+ template-haskell >=2.14.0.0 && <2.15,+ th-lift >=0.8.1 && <0.9,+ transformers >=0.5.6.2 && <0.6++test-suite parser+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-tools: alex -any, happy -any+ hs-source-dirs: test/parser+ other-modules:+ Paths_flp+ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HUnit ==1.6.*,+ array >=0.5.3.0 && <0.6,+ base >=4.7 && <5,+ containers >=0.6.0.1 && <0.7,+ deepseq >=1.4.4.0 && <1.5,+ flp -any,+ haskell-src-meta >=0.8.3 && <0.9,+ prettyprinter >=1.2.1.1 && <1.3,+ template-haskell >=2.14.0.0 && <2.15,+ test-framework ==0.8.*,+ test-framework-hunit ==0.3.*,+ th-lift >=0.8.1 && <0.9,+ transformers >=0.5.6.2 && <0.6
+ src/Language/Floorplan.hs view
@@ -0,0 +1,9 @@+module Language.Floorplan+ ( module Language.Floorplan.Syntax+ , module Language.Floorplan.Parser+ , module Language.Floorplan.Token+ ) where+import Language.Floorplan.Syntax+import Language.Floorplan.Parser+import Language.Floorplan.Token+
+ src/Language/Floorplan/Core/Compiler.hs view
@@ -0,0 +1,171 @@+module Language.Floorplan.Core.Compiler where+import Language.Floorplan.Core.Syntax hiding (accum)+import Language.Floorplan.Syntax+import qualified Data.Map.Strict as M+import Data.List (sort)+import Data.Maybe (fromJust, isJust)++-- | Build the dictionary / map of layer (and field) identifiers to their inner Demarc.+-- Todo: warning when multiple layers have the same name (which one `union` picks is undefined behavior)+buildMap :: Demarc -> M.Map String Demarc+buildMap (Enum{}) = M.empty+buildMap (Bits{}) = M.empty+buildMap (Union ds) = M.unions $ map buildMap ds+buildMap (Seq ds) = M.unions $ map buildMap ds+buildMap (PtrF{}) = M.empty+buildMap (PtrL{}) = M.empty+buildMap (Blob{}) = M.empty+buildMap (Graft{}) = M.empty+buildMap f@(Field name d) = M.insert name d (buildMap d)+buildMap (Pound d) = buildMap d+buildMap (Repetition _ d) = buildMap d+buildMap l@(Layer{}) = M.insert (name l) l (buildMap $ rhs l)++getNames :: Demarc -> [String]+getNames = let+ gN (Field n _) = Just n+ gN (Layer { name = n }) = Just n+ gN _ = Nothing+ in accum gN++-- | Grafting pre-processing pass+grafting' :: M.Map String Demarc -> Demarc -> Demarc+grafting' ds demarc = let++ lookup lid =+ case M.lookup lid ds of+ Nothing -> error $ "Undefined symbol '" ++ lid ++ "' during graft pre-processing phase."+ Just d -> d++ -- | Bool is whether or not we changed the input value+ gr (Graft (lid, args)) =+ case lookup lid of+ (Field _ d) -> (d, True)+ l@(Layer{}) -> (l, True) -- TODO: replace formals with args (no partial application)+ gr d = (d, False)++ in case fmapD gr demarc of+ (d, True) -> grafting' ds d+ (d, False) -> d++grafting :: [Demarc] -> Demarc -> Demarc+grafting ds demarc = grafting' (M.unions $ map buildMap ds) demarc++-- | This can be done before or after grafting phase. It checks that every @Layer@ and @Field@+-- has a globally unique name, reporting an error when the name is not unique.+checkUniqNames :: [Demarc] -> [String]+checkUniqNames ds =+ let ns = foldr (\a b -> getNames a ++ b) [] ds++ -- Assumes the input list is already sorted (duplicates are adjacent)+ getDups [] = []+ getDups (x:[]) = []+ getDups (x:y:ys)+ | x == y = y : getDups (dropWhile (== y) ys)+ | otherwise = getDups (y:ys)++ in getDups $ sort ns++countGrafting :: [Demarc] -> Int+countGrafting = let+ fn (Graft{}) = True+ fn _ = False+ in sum . map (countMatches fn)++-- | How many bytes are required for an Enum containing the given fields.+-- This computes ceiling(log_2(length(flags)) / 8).+enumBytes :: [FlagID] -> Int+enumBytes fs+ | len == 1 = 1+ | otherwise = (bytes 1)+ where len = length fs+ bytes acc+ | len <= acc = 0+ | otherwise = 1 + (bytes (acc * 256))++-- | TODO: parametrized delta_prim for architecture-dependent types+delta_prim :: Primitive -> Int+delta_prim Bit = 1+delta_prim Byte = 8+delta_prim Word = 8 * (delta_prim Byte)+delta_prim Page = 4096 * (delta_prim Byte)++pow :: Int -> Int -> Int+pow b e+ | e < 0 = error "exponentiation with negative exponent"+ | e == 0 && b == 0 = error "indeterminate exponent"+ | e == 0 = 1+ | e > 0 = b * (pow b (e - 1))++-- | Computes over arithmetic expressions in terms of literals+delta_lit :: LitArith -> Int+delta_lit (Plus l r) = (+) (delta_lit l) (delta_lit r)+delta_lit (Minus l r) = (-) (delta_lit l) (delta_lit r)+delta_lit (Times l r) = (*) (delta_lit l) (delta_lit r)+delta_lit (Div l r) = quot (delta_lit l) (delta_lit r)+delta_lit (Exponent b e) = pow (delta_lit b) (delta_lit e)+delta_lit (Lit l) = l++-- | Computes number of bits+delta :: SizeArith -> Int+delta (SizePlus l r) = (+) (delta l) (delta r)+delta (SizeMinus l r) = (-) (delta l) (delta r)+delta (SizeLit Nothing p) = delta_prim p+delta (SizeLit (Just lit) p) = (delta_lit lit) * (delta_prim p)++delta_bits = delta++bits2bytesUP v+ | v == 0 = 0+ | v <= 8 = 1+ | otherwise = 1 + bits2bytesUP (v - 8)++-- | Rounds up @SizeArith@ to the nearest whole byte.+delta_bytes :: SizeArith -> Int+delta_bytes sz = bits2bytesUP (delta sz)++fresh :: Demarc -> FormalID+fresh d = head (dropWhile (flip elem $ free_vars d) $ map (("var_" ++) . show) [0..])++compile :: Demarc -> BaseExp+compile (Enum fs) = Attr (BaseType $ EnumBT fs) (Prim $ enumBytes fs)+compile (Bits fs) = let fs' = zip (map fst fs) $ map (delta_bits . snd) fs+ in Attr (BaseType $ BitsBT fs') (Prim $ bits2bytesUP $ sum $ map snd fs')+compile (Union []) = Prim 0+compile (Union (d:ds)) = foldl (:||) (compile d) $ map compile ds+compile (Seq []) = Prim 0+compile (Seq (d:ds)) = foldl (:+) (compile d) $ map compile ds+compile (PtrF field) = Attr (BaseType $ PtrBT field) $ compile (Blob $ SizeLit Nothing Word)+compile (PtrL layer) = Attr (BaseType $ PtrBT layer) $ compile (Blob $ SizeLit Nothing Word)+compile (Blob sz) = Attr (BaseType $ SizeBT sz) $ Prim $ delta_bytes sz+compile (Field f d) = (:::) f (compile d)+compile (Pound d) = let f = fresh d+ in Exists f $ f :# (compile d)+compile (Repetition f d) = f :# (compile d)+compile l@(Layer+ { name = n+ , formals = fs+ , magnitude = m+ , alignment = a+ , magAlign = ma+ , contains = cs+ , rhs = d+ }) = n ::: (exists $ mag $ align $ contains $ compile d)+ where exists :: BaseExp -> BaseExp+ exists e+ | null fs = e+ | otherwise = foldr Exists (Exists (head fs) e) (tail fs)+ mag+ | isJust m = Con (delta_bytes $ fromJust m)+ | isJust ma = Con (delta_bytes $ fromJust ma)+ | otherwise = id+ align+ | isJust a = (flip (:@)) (delta_bytes $ fromJust a)+ | isJust ma = (flip (:@)) (delta_bytes $ fromJust ma)+ | otherwise = id+ contains :: BaseExp -> BaseExp+ contains e+ | null cs = e+ | otherwise = foldr Attr (Attr (Contains $ head cs) e) (map Contains $ tail cs)+compile (Graft _) = error "Grafting is illegal during the compile phase."+
+ src/Language/Floorplan/Core/Syntax.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Language.Floorplan.Core.Syntax where++import Data.Maybe (maybeToList)++import Language.Floorplan.Syntax (LayerID, FormalID, FlagID, FieldID, SizeArith(..))++type Nat = Int -- >= 0+type Align = Int -- >= 1++type ExistsID = String -- ^ Formal identifiers (bound by Exists)+type NameID = String -- ^ Names of bound layers and fields++data Exp a+ = Prim Nat -- ^ Primitive number of bytes+ | Con Nat (Exp a) -- ^ Constrained+ | (:@) (Exp a) Align -- ^ Alignment+ | (:+) (Exp a) (Exp a) -- ^ Sequencing+ | (:||) (Exp a) (Exp a) -- ^ Union / alternation+ | (:::) NameID (Exp a) -- ^ Layer (and field) name binding+ | Exists ExistsID (Exp a) -- ^ Formal name binding+ | (:#) ExistsID (Exp a) -- ^ Repetitions+ | Attr a (Exp a) -- ^ Extensible attributes+ deriving (Eq, Ord, Show)++data Attribute ty+ = Contains NameID+ | BaseType ty+ deriving (Eq, Ord, Show)++data BaseType+ = EnumBT [FlagID]+ | BitsBT [(NameID, Int)]+ | PtrBT NameID+ | SizeBT SizeArith+ deriving (Eq, Ord, Show)++-- | Default core expression type for FLP compiler targeting Rust library+-- (with contains(...) attibutes):+type BaseExp = Exp (Attribute BaseType)++-- | Accumulate the results of applying some function to+-- every node in the Exp AST.+accum :: (Exp a -> Maybe b) -> Exp a -> [b]+accum fn e@(Prim{}) = maybeToList (fn e)+accum fn e1@(Con _ e2) = maybeToList (fn e1) ++ accum fn e2+accum fn e1@(e2 :@ _) = maybeToList (fn e1) ++ accum fn e2+accum fn e1@(e2 :+ e3) = maybeToList (fn e1) ++ accum fn e2 ++ accum fn e3+accum fn e1@(e2 :|| e3) = maybeToList (fn e1) ++ accum fn e2 ++ accum fn e3+accum fn e1@(_ ::: e2) = maybeToList (fn e1) ++ accum fn e2+accum fn e1@(Exists _ e2) = maybeToList (fn e1) ++ accum fn e2+accum fn e1@(_ :# e2) = maybeToList (fn e1) ++ accum fn e2+accum fn e1@(Attr _ e2) = maybeToList (fn e1) ++ accum fn e2++-- | Call the given function on all subexpressions. Good for fixedpoint+-- functions calling on themselves in recursive case where they don't+-- care which type they see. This is slightly dangerous in the case where+-- something gets added to the core calculus. If this happens, PLEASE+-- check all callers of this function to see if they should handle the+-- new case personally.+callSub :: (Exp a -> [b]) -> Exp a -> [b]+callSub fn (Prim{}) = []+callSub fn (Con _ e) = fn e+callSub fn (e :@ _) = fn e+callSub fn (e1 :+ e2) = fn e1 ++ fn e2+callSub fn (e1 :|| e2) = fn e1 ++ fn e2+callSub fn (_ ::: e) = fn e+callSub fn (Exists _ e) = fn e+callSub fn (_ :# e) = fn e+callSub fn (Attr _ e) = fn e++plus :: Maybe Int -> Maybe Int -> Maybe Int+plus a b = do+ a' <- a+ b' <- b+ return $ a' + b'++-- | Conservatively computes the size of the given expression,+-- returning Nothing when a fixed size isn't easily known.+expSize :: Exp a -> Maybe Int+expSize (Prim n) = return n+expSize (Con n _) = return n+expSize (e :@ _) = expSize e+expSize (e1 :+ e2) = expSize e1 `plus` expSize e2+expSize (e1 :|| e2) =+ let s1 = expSize e1+ s2 = expSize e2+ in if s1 == s2 then s1 else Nothing+expSize (_ ::: e) = expSize e+expSize (Exists _ e) = expSize e+expSize (_ :# _) = Nothing -- Conservative assumption+expSize (Attr _ e) = expSize e++-- | Just like @accum@, but also tracks the number of bytes of memory+-- that come before the subexpression for which we call the fncn.+l2r :: forall a b. (Maybe Nat -> Exp a -> Maybe b) -> Exp a -> [b]+l2r fn e' = let++ mTL :: Maybe Nat -> Exp a -> [b]+ mTL i = maybeToList . fn i++ lr :: Maybe Nat -> Exp a -> [b]+ lr i e@(Prim{}) = mTL i e+ lr i e1@(Con _ e2) = mTL i e1 ++ lr i e2+ lr i e1@(e2 :@ _) = mTL i e1 ++ lr i e2+ lr i e1@(e2 :+ e3) = mTL i e1 ++ (lr i e2 ++ lr (i `plus` expSize e2) e3)+ lr i e1@(e2 :|| e3) = mTL i e1 ++ (lr i e2 ++ lr i e3)+ lr i e1@(_ ::: e2) = mTL i e1 ++ lr i e2+ lr i e1@(Exists _ e2) = mTL i e1 ++ lr i e2+ lr i e1@(_ :# e2) = mTL i e1 ++ lr Nothing e2+ lr i e1@(Attr _ e2) = mTL i e1 ++ lr i e2++ in lr (Just 0) e'+
+ src/Language/Floorplan/Parser.y view
@@ -0,0 +1,188 @@+{+module Language.Floorplan.Parser where++import Language.Floorplan.Syntax+import Language.Floorplan.Token+}++%name layers+%tokentype { Token }+%error { parseError }++%token+ seq { TokenSeq }+ union { TokenUnion }+ 'contains' { TokenContains }+ bits { TokenBits }+ bytes { TokenBytes }+ words { TokenWords }+ pages { TokenPages }+ 'ptr' { TokenPtr }+ enum { TokenEnum }+ '->' { TokenArrow }+ '@(' { TokenAtParen }+ ')@' { TokenParenAt }+ '@|' { TokenAtBar }+ '|@' { TokenBarAt }+ '(' { TokenLParen }+ ')' { TokenRParen }+ '<' { TokenLess }+ '>' { TokenGreater }+ '<$' { TokenLessD }+ '$>' { TokenGreaterD }+ '|' { TokenBar }+ '||' { TokenBarBar }+ '{' { TokenLCurl }+ '}' { TokenRCurl }+ '#' { TokenPound }+ ':' { TokenColon }+ ',' { TokenComma }+ '+' { TokenPlus }+ '-' { TokenMinus }+ '*' { TokenTimes }+ '/' { TokenDiv }+ '^' { TokenExponent }+ literal { TokenNum $$ }+ UpperID { TokenUpperID $$ }+ LowerID { TokenLowerID $$ }++-- %left '+' '-'+-- %left '*' '/'+-- %left '^'+%%++{- ------------------------------------------------------------------------- -}+{- Floorplan layers -}++layers : {- empty -} { [] }+ | layers layer { $2 : $1 }++layerID : UpperID { $1 }+fieldID : LowerID { $1 }+formalID : LowerID { $1 }+flagID : UpperID { $1 }++layer : layerSimple { $1 }+ | '(' layerSimple ')' { $2 }++layerSimple : layerID formals mag align contains '->' demarc { Layer $1 $2 $3 $4 Nothing $5 $7 }+ | layerID formals align mag contains '->' demarc { Layer $1 $2 $4 $3 Nothing $5 $7 }+ | layerID formals magAlign contains '->' demarc { Layer $1 $2 Nothing Nothing $3 $4 $6 }+ | layerID formals mag contains '->' demarc { Layer $1 $2 $3 Nothing Nothing $4 $6 }+ | layerID formals align contains '->' demarc { Layer $1 $2 Nothing $3 Nothing $4 $6 }+ | layerID formals contains '->' demarc { Layer $1 $2 Nothing Nothing Nothing $3 $5 }++mag : '||' sizeArith '||' { Just $2 }++align : '@(' sizeArith ')@' { Just $2 }++magAlign : '@|' sizeArith '|@' { Just $2 }++contains : {- empty -} { [] }+ | contains 'contains' '(' layerID ')' { $4 : $1 }++formals : {- empty -} { [] }+ | '<' formalsInner '>' { reverse $2 }+ | '<' formalsInner ',' '>' { reverse $2 }++formalsInner : formalID { [$1] }+ | formalsInner ',' formalID { $3 : $1 }++{- ------------------------------------------------------------------------- -}++demarcVal : enum '{' enumExps '}' { Enum (reverse $3) }+ | enum '{' enumExps '|' '}' { Enum (reverse $3) }+ | bits '{' bitsExps '}' { Bits (reverse $3) }+ | bits '{' bitsExps ',' '}' { Bits (reverse $3) }+ | union '{' unionExps '}' { Union (reverse $3) }+ | union '{' unionExps '|' '}' { Union (reverse $3) }+ | seq '{' seqExps '}' { Seq (reverse $3) }+ | seq '{' seqExps ',' '}' { Seq (reverse $3) }+ | sizeArith { Blob $1 }+ | grafting { Graft $1 }+ | ptr { $1 }+ | field { $1 }+ | layer { $1 }++seqExps : demarc { [$1] }+ | seqExps ',' demarc { $3 : $1 }++unionExps : demarc { [$1] }+ | unionExps '|' demarc { $3 : $1 }++demarc : '#' demarcVal { Pound $2 }+ | demarcVal { $1 }+ | formalID demarcVal { Repetition $1 $2 }++field : fieldID ':' demarc { Field $1 $3 }++ptr : layerID 'ptr' { PtrL $1 }+ | fieldID 'ptr' { PtrF $1 }++grafting : layerID '<$' args '$>' { ($1, reverse $3) }+ | layerID '<$' args ',' '$>' { ($1, reverse $3) }+ | layerID { ($1, []) }++args : formalID { [ArgF $1] }+ | literal { [ArgL $1] }+ | args ',' formalID { (ArgF $3) : $1 }+ | args ',' literal { (ArgL $3) : $1 }++-- formalOrLiteral { [$1] }+-- | args ',' formalOrLiteral { $3 : $1 }+--+--formalOrLiteral : formalID { ArgF $1 }+-- | literal { ArgL $1 }++enumExps : flagID { [$1] }+ | enumExps '|' flagID { $3 : $1 }++bitsExps : bitsExp { [$1] }+ | bitsExps ',' bitsExp { $3 : $1 }++bitsExp : flagID ':' sizeArith { ($1, $3) }++{- ------------------------------------------------------------------------- -}++sizePrim : prim { $1 }+ | archPrim { $1 }++prim : bits { Bit }+ | bytes { Byte }++archPrim : words { Word }+ | pages { Page }++litArith : litArith '+' term { Plus $1 $3 }+ | litArith '-' term { Minus $1 $3 }+ | term { $1 }++term : term '*' factor { Times $1 $3 }+ | term '/' factor { Div $1 $3 }+ | factor { $1 }++factor : factor '^' exponent { Exponent $1 $3 }+ | exponent { $1 }++exponent : '(' litArith ')' { $2 }+ | literal { Lit $1 }++sizeArith : '(' sizeArith ')' { $2 }+ | sizeArith '+' termSz { SizePlus $1 $3 }+ | sizeArith '-' termSz { SizeMinus $1 $3 }+ | termSz { $1}++termSz : litArith sizePrim { SizeLit (Just $1) $2 }+ | sizePrim { SizeLit Nothing $1 }++{- ------------------------------------------------------------------------- -}++{++parseError :: [Token] -> a+parseError xs = error $ "Parse error with remaining input: " ++ show xs++parseLayers :: String -> [Demarc]+parseLayers = reverse . layers . scanTokens+}+
+ src/Language/Floorplan/Rust.hs view
@@ -0,0 +1,5 @@+module Language.Floorplan.Rust+ ( module Language.Floorplan.Rust.Compiler+ ) where+import Language.Floorplan.Rust.Compiler+
+ src/Language/Floorplan/Rust/Common.hs view
@@ -0,0 +1,170 @@+module Language.Floorplan.Rust.Common+ where+{- Functions and names applicable to all code gen phases / passes+ -}++import Language.Rust.Parser as P+import Language.Rust.Syntax as R+import Language.Rust.Quote+import Language.Rust.Data.Ident+import Language.Rust.Data.Position++import Language.Floorplan.Core.Syntax++import Data.Functor ( ($>) )+import Data.Ord (comparing)+import Data.List (sortBy, nub)+import Data.Char (toUpper, toLower)++import Language.Floorplan.Rust.Types+import qualified Debug.Trace as D++bytesInWord :: Int+bytesInWord = 8++bitsInByte :: Int+bitsInByte = 8++isPow2 k = elem k $ map (2 ^) [0..k]++-- | Log base `i` of `n` rounded up.+log' :: Int -> Int -> Int+log' i n = length (takeWhile (< n) (iterate (* 2) 1))++log2 :: Int -> Int+log2 = log' 2++-- TODO: Introduce spans based on position in these Haskell files.+fakeSpan = Span (Position 0 0 0) (Position 0 0 0)+fS = fakeSpan++-- TODO: put Language.Rust.* accessors in their own module:+-- | Makes a Rust expression of from an integer+mkIntExp :: Int -> R.Expr Span+mkIntExp i = P.parse' $ P.inputStreamFromString $ show i++mkBin' i+ | i == 0 = []+ | i `mod` 2 == 0 = '0' : mkBin' (i `div` 2)+ | i `mod` 2 == 1 = '1' : mkBin' (i `div` 2)++mkBinU8 i+ | i >= 256 = error $ "Cannot make u8 from i=" ++ show i+ | otherwise = take (8 - (length $ mkBin' i)) (repeat '0') ++ (reverse $ mkBin' i)++mkBinExp :: Int -> R.Expr Span+mkBinExp i = P.parse' $ P.inputStreamFromString $ "0b" ++ mkBinU8 i++offsetName :: NameID -> String+offsetName n+ = allUpper n ++ "_OFFSET_BYTES"++containsFnName :: NameID -> String+containsFnName ns+ = "contains_" ++ firstLower ns++firstLower [] = error "empty NameID!"+firstLower (n:ns) = toLower n : ns++firstUpper [] = error "empty NameID!"+firstUpper (n:ns) = toUpper n : ns++allUpper = map toUpper++initSeqName :: [NameID] -> String+initSeqName _ = "init_canonical_sequence"++bumpAllocName :: NameID -> String+bumpAllocName n+ = "bump_new_" ++ n++bumpValidName :: NameID -> NameID -> String+bumpValidName n1 n2+ = firstLower n1 ++ "_is_validly_before_" ++ firstLower n2++initAfterName :: NameID -> NameID -> String+initAfterName n1 n2+ = "init_" ++ firstLower n2 ++ "_after_" ++ firstLower n1++memsetUntilName :: NameID -> NameID -> String+memsetUntilName n1 n2+ = "memset_" ++ firstLower n1 ++ "_until_" ++ firstLower n2++castFromName :: NameID -> NameID -> String+castFromName from to+ = "cast_" ++ firstLower from ++ "_to_" ++ firstLower to++fromIdxName :: NameID -> String+fromIdxName from+ = firstLower from ++ "_from_idx"++toIdxName :: NameID -> String+toIdxName from+ = firstLower from ++ "_to_idx"++logBytesName :: NameID -> String+logBytesName n+ = "LOG_" ++ bytesName n++bytesName :: NameID -> String+bytesName n+ = "BYTES_IN_" ++ allUpper n++-- | All named entities get an addrName:+addrName xs = firstUpper xs ++ "Addr"++addrEndName n = firstUpper n ++ "AddrEnd"++enumName xs = "__FLP_IDX_" ++ map toUpper xs++-- | Only for (known to be) fixed-width things:+structName xs = firstUpper xs -- ++ "Struct"++getterName xs = firstLower xs++reverseGetterName xs = "from_" ++ firstLower xs++skipperName ns = "skip_bytes_to_" ++ firstUpper ns++jumperName ns = "jump_to_" ++ firstUpper ns++nextName ns = "next_" ++ firstUpper ns++bitsGetterName sz xs+ | sz == 1 = "get_" ++ xs ++ "_bit"+ | otherwise = "get_" ++ xs ++ "_bits"++bitsFromerName _ [] = error "empty NameID!"+bitsFromerName sz (x:xs)+ | sz == 1 = "set_" ++ x : xs ++ "_from_bool"+ | otherwise = "set_" ++ x : xs ++ "_from_u8"++firstGetterName xs = "get_first_" ++ firstLower xs++mkTy :: NameID -> Ty Span+mkTy s = P.parse' $ P.inputStreamFromString s++bytesAlignName n = allUpper n ++ "_BYTES_ALIGN"++logAlignName n = allUpper n ++ "_LOG_BYTES_ALIGN"++fieldPtrGetterName fs = "load_" ++ firstUpper fs ++ "Addr"+fieldPtrSetterName fs = "store_" ++ firstUpper fs ++ "Addr"++fieldStructGetterName fs = "load_" ++ firstUpper fs+fieldStructSetterName fs = "store_" ++ firstUpper fs++-- | Determine all existential-bound names brought into+-- scope by this expression. Alignment and Constrained+-- can be traversed because only a ":#" can refer to names.+findExists :: BaseExp -> [BaseExp]+findExists (Prim{}) = []+findExists (Con _ e) = findExists e+findExists (e :@ _) = findExists e+findExists (_ :+ _) = []+findExists (_ :|| _) = []+findExists (_ ::: _) = []+findExists e@(Exists _ e') = e : findExists e'+findExists (_ :# _) = []+findExists (Attr _ e) = findExists e+
+ src/Language/Floorplan/Rust/Compiler.hs view
@@ -0,0 +1,908 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, BangPatterns #-}+module Language.Floorplan.Rust.Compiler+ ( genRust, writeModule+ ) where++import System.IO (IOMode(..), openFile, hClose)+import Data.Typeable (Typeable(..))++import Language.Rust.Parser as P+import Language.Rust.Syntax as R+import Language.Rust.Quote+import Language.Rust.Data.Ident+import Language.Rust.Data.Position++import Language.Floorplan.Core.Syntax++import Data.Bifunctor ( bimap )+import Data.Functor ( ($>) )+import Data.Ord (comparing)+import Data.List (sortBy, nub, inits)+import Data.Char (toUpper, toLower)+import Data.Maybe (isJust, fromMaybe)+import Data.Bits+import qualified Debug.Trace as D++import Language.Rust.Pretty (writeSourceFile)+import Language.Floorplan.Rust.Types+import Language.Floorplan.Rust.Mapping+import Language.Floorplan.Rust.Common+import Language.Floorplan.Syntax(SizeArith(..), Primitive(..), FlagID(..))++moduleToItems :: RustItem -> [Item Span]+moduleToItems (RustImpl n is outer_is) =+ nub outer_is +++ [ Impl [] InheritedV Final Normal Positive+ (Generics [] [] (WhereClause [] fS) fS) Nothing (mkTy n) (nub is) fS+ ]+moduleToItems (TopLevel is) = is++--(mkIdent n) (Just $ nub is) fakeSpan++-- | TODO: modules with same name should be merged into one.+mergeImpls :: [RustItem] -> [Item Span]+mergeImpls ms = let++ merge [] = []+ merge (x:[]) = [x]+ merge (x@(RustImpl xN xIS xOuter):y@(RustImpl yN yIS yOuter):ys)+ | xN == yN = merge $ (RustImpl xN (xIS ++ yIS) (xOuter ++ yOuter)) : ys+ | otherwise = x : merge (y:ys)+ merge (x@(TopLevel ns):y@(TopLevel ns'):ys) =+ merge $ (TopLevel $ ns ++ ns') : ys+ merge (x:y:ys) = x : merge (y : ys)++ in concatMap moduleToItems $ merge $ sortBy (comparing rustItemComparator) ms++genRust :: [BaseExp] -> SourceFile Span+genRust bes =+ SourceFile Nothing headerAttrs $+ headerItems+ ++ genFixedWidthStructs bes+ ++ (mergeImpls $+ genStaticOffsets bes+ ++ genEnumAll' bes+ ++ genFieldPtrGetters bes+ ++ genMaps bes+ ++ genContainsMethods bes+ ++ genGetFirstMethods bes+ ++ genBitsAccessors bes+ ++ genDynamicSkippers bes+ ++ genAddrAddr bes+ ++ genNeighborParents bes+ ++ genDistributeContainsAttr bes+ ++ genEnumAccessors bes+ ++ genShadowAlloc bes+ ++ genStoreWord bes+ -- TODO: Check whether a RemainderAddr occurs *after* a LimitAddr, i.e. when the LHS+ -- of two sequential named fields occurs at an address greater than the address of+ -- the thing on the RHS, it's clearly malformed (i.e. the RTS speculatively made+ -- a new address, but realized that it's not allowed - TODO: eventually want some+ -- way to enforce, e.g. with types, the developer turns a "Speculative" address+ -- into a "Real" one, and that speculative addresses get generated for methods here+ -- that can't know for sure they'll produce pointers to valid things, but that+ -- can be "marked" as valid by doing a check).+ )++-- | Must return a nonempty list+findAlignment :: BaseExp -> [Int]+findAlignment (Prim{}) = [1]+findAlignment (Con _ e) = findAlignment e+findAlignment (_ :@ align) = [align]+findAlignment (e :+ _) = findAlignment e -- Alignment of first thing+findAlignment (e1 :|| e2) =+ let a1 = findAlignment e1+ a2 = findAlignment e2+ in a1 ++ a2+findAlignment (_ ::: e) = findAlignment e+findAlignment (Exists _ e) = findAlignment e+findAlignment (_ :# e) = findAlignment e -- Alignment of first repetition+findAlignment (Attr _ e) = findAlignment e++-- | Generate the items associated with an Impl, as necessary for+-- making a new e.g. `FooAddr` type.+genAssocItems :: NameID -> BaseExp -> [Item Span]+genAssocItems n e =+ let nAddr = addrName n+ nAddrEnd = addrEndName n+ -- TODO: Alignment should conservatively be a list, not just the smallest one found+ -- (to detect alignment errors from a pointer as precisely as possible,+ -- though non-power-of-two alignments are rare / uncommon, so choosing+ -- the smallest one is likely sufficient for most use cases):+ bytesAlign = bytesAlignName n+ + sz = expSize e+ (Just sz') = expSize e++ bytes = [items| pub const ${i| bytesName n |} : usize = ${e| mkIntExp sz' |}; |]++ consAlign = foldl mini 0 $ findAlignment e+ + alignConst = [items| pub const $bytesAlign : usize = 1 << ${i| logAlignName n |}; // ${e| mkIntExp consAlign |}; |]+ alignConst' = [items| pub const $bytesAlign : usize = ${e| mkIntExp consAlign |}; |]+ + logAlign+ | isPow2 consAlign = [items| pub const ${i| logAlignName n |} : usize = ${e| mkIntExp $ log2 consAlign |}; |] ++ alignConst+ | otherwise = alignConst'++ logBytes+ | isJust sz && isPow2 sz' =+ bytes+ ++ [items| pub const ${i| logBytesName n |} : usize = ${e| mkIntExp $ log2 sz' |};+ |]+ | isJust sz = bytes+ | otherwise = []++ -- | Ignore the zero+ mini x 0 = x+ mini 0 x = x+ mini x y = min x y++ in logAlign +++ [items| #[repr (C)]+ #[derive(Copy, Clone, Eq, Hash)]+ pub struct $nAddr(usize);+ deriveAddr!($nAddr, $bytesAlign);+ + #[repr (C)]+ #[derive(Copy, Clone, Eq, Hash)]+ pub struct $nAddrEnd(usize);+ deriveAddr!($nAddrEnd, 1);+ |] ++ logBytes++genEnumAll :: (Int, (NameID, BaseExp)) -> RustItem+genEnumAll (i, (n, e)) =+ let nEnum = enumName n+ in RustImpl (addrName n) []+ [items| pub const $nEnum : u8 = ${e| mkIntExp i |};+ |]++mkNameStringExp :: (NameID, BaseExp) -> Expr Span+mkNameStringExp (n, _) = Lit [] (Str (allUpper n) Cooked Unsuffixed fakeSpan) fakeSpan++genFLPArray :: [(NameID, BaseExp)] -> RustItem+genFLPArray nes = TopLevel+ [items| pub const __FLP_IDX_UNMAPPED : u8 = 0;+ pub const __FLP_TYPES: &'static [&'static str] = & ${e| Vec []+ (mkNameStringExp ("UNMAPPED", undefined) : map mkNameStringExp nes) fakeSpan |}; |]++genStoreWord :: [BaseExp] -> [RustItem]+genStoreWord bes = let+ gSW :: BaseExp -> Maybe RustItem+ gSW (n ::: e) = do+ sz <- expSize e+ if sz == bytesInWord then return+ (RustImpl (addrName n)+ (snd [implItems|+ pub fn store_word(&self, val: usize) {+ self.store::<usize>(val);+ }+ |])+ [])+ else Nothing+ gSW rest = Nothing++ genStoreStruct :: BaseExp -> Maybe RustItem+ genStoreStruct (n ::: e) = do+ sz <- expSize e+ let sN = structName n+ let store_struct = fieldStructSetterName n+ let load_struct = fieldStructGetterName n+ return (RustImpl (addrName n)+ (snd [implItems|+ pub fn $store_struct(&self, val: $sN) {+ self.store::<$sN>(val);+ }+ pub fn $load_struct(&self) -> $sN {+ self.load::<$sN>()+ } |]) [])+ genStoreStruct _ = Nothing+ in concatMap (accum genStoreStruct) bes ++ concatMap (accum gSW) bes++genEnumAll' :: [BaseExp] -> [RustItem]+genEnumAll' bes =+ let findNames :: BaseExp -> Maybe (NameID, BaseExp)+ findNames (n ::: e) = Just (n, e)+ findNames _ = Nothing+ in genFLPArray (nub $ concatMap (accum findNames) bes)+ : map genEnumAll (zip [1 :: Int .. ] (nub $ concatMap (accum findNames) bes))++-- [Item ()]+genStaticOffsets :: [BaseExp] -> [RustItem]+genStaticOffsets bes =+ let+ --(NameID, [ImplItem Span])+ findSO :: BaseExp -> Maybe RustItem+ findSO (n ::: e2) = Just $ RustImpl (addrName n) (concat $ l2r (mkN n) e2) (genAssocItems n e2)+ findSO _ = Nothing++ -- Finds all "neighboring" named subexpressions that are a static+ -- distance from the beginning of the subexpression.+ mkN :: NameID -> Maybe Nat -> BaseExp -> Maybe [ImplItem Span]+ mkN _ Nothing _ = Nothing+ mkN nOuter (Just k) (n ::: _) = Just $+ let aN = addrName n+ oN = offsetName n+ gN = getterName n+ rev_gN = reverseGetterName n+ aNOuter = addrName nOuter in+ -- TODO: [items| |] quasiquoter for multiple items+ snd [implItems|+ pub const ${i|oN|}: usize = ${e| mkIntExp k |};+ pub fn $gN(&self) -> $aN {+ self.plus::<$aN>($aNOuter :: $oN)+ }+ pub fn $rev_gN(addr: $aN) -> $aNOuter {+ addr.sub::<$aNOuter>($aNOuter :: $oN)+ }+ |]+ --[item| const FOO: usize = 22; |]+ mkN _ _ _ = Nothing++ in concatMap (accum findSO) bes++genFieldPtrGetters :: [BaseExp] -> [RustItem]+genFieldPtrGetters bes = let++ findFieldPtr :: BaseExp -> Maybe RustItem+ findFieldPtr (n ::: (Attr (BaseType (PtrBT field)) blob)) =+ let aN = addrName n+ get_field = fieldPtrGetterName field+ set_field = fieldPtrSetterName field+ newAddr = addrName field in+ Just $ RustImpl (addrName n)+ (snd $ [implItems|+ pub fn $get_field(self) -> $newAddr {+ let ret = self.load::<$newAddr>();+ //backtraceHere!(ret);+ ret+ }+ pub fn $set_field(self, val : $newAddr) {+ //backtraceHere!(val);+ self.store::<$newAddr>(val)+ }+ |])+ []+ findFieldPtr _ = Nothing++ in concatMap (accum findFieldPtr) bes++-- | Distribute the 'contains(...)' attributes on layers onto all of the named fields+-- (and other layers) one-level-deep (don't traverse the AST through names), such that+-- we get out conversion functions to/from the "contained" thing and the inner names found.+-- These casting functions get associated with the container itself, not the addresses+-- being cast so as to keep how the contains() attribute works simple to understand.+--+-- TODO: We can do *all* sorts of assertions here, such as checking alignment constraints+-- e.g. if you cast an immix Cell to an immix Line, then that Cell *should* have started+-- on an aligned-Line. If this was not the case, either there was an error, or we should+-- provide support for optional types that fail when alignment fails. It's probably better+-- for now though to just require that the system developer check alignment constraints+-- on there own and have FLP print out an error message when alignments are broken, that way+-- we can figure out what to do with bad alignments when we have an actual example.+genDistributeContainsAttr :: [BaseExp] -> [RustItem]+genDistributeContainsAttr bes = let++ findNamed :: BaseExp -> Maybe RustItem+ findNamed (n ::: e) = Just $ RustImpl (structName n) (mkDistr e) []+ findNamed _ = Nothing++ mkDistr :: BaseExp -> [ImplItem Span]+ mkDistr (Attr (Contains nCont) e) = distribute nCont e ++ mkDistr e -- Distribute 'contains()' things+ mkDistr (n ::: _) = [] -- Only go one level of naming deep.+ mkDistr e = callSub mkDistr e -- Recursive call on subexpressions++ distribute :: NameID -> BaseExp -> [ImplItem Span]+ distribute nCont (nInner ::: eInner) = let+ cast_from1 = castFromName nCont nInner+ cast_from2 = castFromName nInner nCont+ nContA = addrName nCont+ nInnerA = addrName nInner+ in (snd $+ [implItems|+ pub fn $cast_from1(addr : $nContA) -> $nInnerA { $nInnerA::from_usize(addr.as_usize()) }+ pub fn $cast_from2(addr : $nInnerA) -> $nContA { $nContA::from_usize(addr.as_usize()) }+ |]) ++ distribute nCont eInner+ distribute nCont e = callSub (distribute nCont) e++ in concatMap (accum findNamed) bes++genContainsMethods :: [BaseExp] -> [RustItem]+genContainsMethods bes = let++ findNamed :: BaseExp -> Maybe RustItem+ findNamed (n ::: e) = Just $ RustImpl (addrName n) (concat $ l2r (mkContains n) e) []+ findNamed _ = Nothing++ -- Make the 'name_contains()' methods for appropriate subexpressions+ mkContains :: NameID -> Maybe Nat -> BaseExp -> Maybe [ImplItem Span]+ mkContains nOuter sz (nInner ::: _) = Just $+ let containsFn = containsFnName nInner+ innerAddr = addrName nInner+ outerAddrEnd = addrEndName nOuter+ in snd $+ [implItems| pub fn $containsFn(&self, addr: $innerAddr, end: $outerAddrEnd) -> bool {+ addr.as_usize() >= self.as_usize() && addr.as_usize() < end.as_usize()+ }+ |]+ mkContains _ _ _ = Nothing++ in concatMap (accum findNamed) bes++genBitsAccessors :: [BaseExp] -> [RustItem]+genBitsAccessors bes = let++ -- overall size (bytes) -> (curr offset, accumulated) -> (Field Name, Field Size (bits)) -> Result+ -- (b -> a -> b)+ singleField :: Nat -> (Int, [ImplItem Span]) -> (NameID, Int) -> (Int, [ImplItem Span])+ singleField sz (curr_offset, accum) (fieldName, bits)+ | bits == 0 = (curr_offset, accum) -- No bits - continue on (no accessor).+ | bits < bitsInByte && sz == 1 = -- 1-7 bits, no byte-offsets required (because sz==1):+ let getter = bitsGetterName bits fieldName+ fieldNameLow = fieldName ++ "_LOW_BIT"+ fieldNameBits = fieldName ++ "_NUM_BITS"+ fieldNameMask = fieldName ++ "_MASK"+ fromer = bitsFromerName bits fieldName+ getterItem+ | bits == 1 =+ [implItems| pub fn $getter(&self) -> bool { ((self.0[0]) & Self::$fieldNameMask) > 0 }+ pub fn $fromer(b : bool) -> Self { Self([(b as u8) << Self::$fieldNameLow]) }+ |]+ | otherwise =+ [implItems| pub fn $getter(&self) -> u8 { (self.0[0]) & Self::$fieldNameMask }+ pub fn $fromer(v : u8) -> Self { Self([v]) }+ |]+ in (curr_offset + bits, (snd $+ [implItems|+ pub const $fieldNameLow : usize = ${e| mkIntExp curr_offset |};+ pub const $fieldNameBits : usize = ${e| mkIntExp bits |};+ pub const $fieldNameMask : u8 = ${e| mkBinExp $ ((1 `shiftL` (curr_offset + bits)) - 1) .&. (complement ((1 `shiftL` curr_offset) - 1)) |};+ |]) ++ snd getterItem ++ accum)+ | bits == bitsInByte && sz == 1 = -- No offset required, whole byte:+ let getter = bitsGetterName bits fieldName+ fromer = bitsFromerName bits fieldName+ fieldNameBits = fieldName ++ "_NUM_BITS"+ in (curr_offset + bits, (snd $+ [implItems| pub fn $getter(&self) -> u8 { self.0[0] }+ pub fn $fromer(v : u8) -> Self { Self([v]) }+ pub const $fieldNameBits : usize = ${e| mkIntExp bits |};+ |]) ++ accum)+ | otherwise = error $ "TODO: sz=" ++ show sz ++ ", bits=" ++ show bits++ -- Returns ([inside the impl], [outside the impl])+ findBitsExp :: BaseExp -> Maybe ([ImplItem Span], [Item Span])+ findBitsExp (Con _ e) = findBitsExp e+ findBitsExp (e :@ _) = findBitsExp e+ findBitsExp (Exists _ e) = findBitsExp e+ findBitsExp (Attr (BaseType (BitsBT fs)) (Prim sz))+ | sz > 0 = Just $ (snd $ foldl (singleField sz) (0, []) fs, [])+ | otherwise = Nothing+ findBitsExp _ = Nothing++ findNamedBitsExps (name ::: e) = (uncurry $ RustImpl (structName name)) <$> findBitsExp e+ findNamedBitsExps _ = Nothing++ in concatMap (accum findNamedBitsExps) bes++genEnumAccessors :: [BaseExp] -> [RustItem]+genEnumAccessors bes = let++ findEnums :: BaseExp -> Maybe [RustItem]+ findEnums (n ::: (Attr (BaseType (EnumBT fs)) (Prim sz))) = Just $ [ RustImpl (structName n) (mkEnumFns fs sz) [] ]+ findEnums _ = Nothing++ mkEnumFns :: [FlagID] -> Nat -> [ImplItem Span]+ mkEnumFns fs sz = let+ valType+ | sz == 1 = "u8"+ | sz == 2 = "u16"+ | sz == 4 = "u32"+ | sz == 8 = "u64"+ | otherwise = error $ "Unhandled size=" ++ show sz+ in snd+ [implItems|+ #[inline(always)]+ pub fn from_enum(val : $valType) -> Self { Self([val]) }+ #[inline(always)]+ pub fn to_enum(&self) -> $valType { self.0[0] }+ |]++ in concat $ concatMap (accum findEnums) bes+-- pub fn from_enum(val : u8) -> Self { LineMark([val]) }++genDynamicSkippers :: [BaseExp] -> [RustItem]+genDynamicSkippers bes = let++ findDynamic :: BaseExp -> Maybe [RustItem]+ findDynamic (_ :# e) = Just $ iterators (expSize e) (names e) (names e)+ findDynamic _ = Nothing++ names (e1 :|| e2) = names e1 ++ names e2+ names (n ::: e) = n : names e+ names (Con _ e) = names e+ names (e :@ _) = names e+ names (e1 :+ e2)+ | expSize e2 == Just 0 = names e1+ | otherwise = []+ names (Exists _ e) = names e+ names (_ :# _) = []+ names (Attr _ e) = names e+ names (Prim{}) = []++ iterators _ _ [] = []+ iterators s@Nothing ns (n':ns') = let+ skipper name =+ let addrN = addrName name+ skName = skipperName name+ in snd $ [implItems| pub fn $skName(&self, bytes : usize) -> $addrN { self.plus(bytes) } |]+ in (RustImpl (addrName n') (concatMap skipper ns) []) : (iterators s ns ns')+ iterators s@(Just sz) ns (n':ns') = let+ jumper name =+ let addrN = addrName name+ jmpName = jumperName name+ bytesInThing = bytesName n'+ logBytesInThing = logBytesName n'+ in snd $+ if isPow2 sz+ then [implItems|+ pub fn $jmpName(&self, count : usize) -> $addrN {+ self.plus(count << $logBytesInThing)+ } |]+ else [implItems|+ pub fn $jmpName(&self, count : usize) -> $addrN {+ self.plus($bytesInThing * count)+ } |]+ in (RustImpl (addrName n') (concatMap jumper ns) []) : (iterators s ns ns')++ + findNamed :: BaseExp -> Maybe [RustItem]+ findNamed (n ::: e) = innerPound n e+ findNamed _ = Nothing+ + innerPound :: NameID -> BaseExp -> Maybe [RustItem]+ innerPound n (Exists _ e) = innerPound n e+ innerPound n (_ :# e) = Just $ [ RustImpl (addrName n) (fixedSzIters e) [] ]+ innerPound _ _ = Nothing++ fixedSzIters :: BaseExp -> [ImplItem Span]+ fixedSzIters (Attr (BaseType (PtrBT ptrT)) _) =+ let aName = addrName ptrT+ aaName = addrName aName+ nxtName = nextName ptrT+ firstName = firstGetterName aaName+ in snd $+ [implItems| pub fn $nxtName(ptr: $aaName) -> $aaName { ptr.plus(BYTES_IN_WORD) }+ pub fn $firstName(&self) -> $aaName { $aaName(self.as_usize()) }+ |]+ fixedSzIters (e1 :|| e2) = fixedSzIters e1 ++ fixedSzIters e2+ fixedSzIters (n ::: _) = []+ fixedSzIters (Con _ e) = fixedSzIters e+ fixedSzIters (e1 :+ e2)+ | expSize e2 == Just 0 = fixedSzIters e1+ | otherwise = []+ fixedSzIters (Exists _ e) = fixedSzIters e+ fixedSzIters (_ :# _) = []+ fixedSzIters (Prim {}) = []+ fixedSzIters (Attr _ e) = fixedSzIters e++ in (concat $ concatMap (accum findDynamic) bes) ++ (concat $ concatMap (accum findNamed) bes)++genAddrAddr :: [BaseExp] -> [RustItem]+genAddrAddr bes = let++ findPtrBT (Attr (BaseType (PtrBT ptrT)) _) =+ let aName = addrName ptrT+ aaName = addrName aName+ bytesAlign = bytesAlignName aName+ getter = getterName aName+ in Just $ RustImpl aaName+ (snd $ [implItems|+ pub fn $getter(&self) -> $aName { self.load() }+ |])+ [items| #[repr (C)]+ #[derive(Copy, Clone, Eq, Hash)]+ pub struct $aaName(usize);+ pub const $bytesAlign : usize = 1;+ deriveAddr!($aaName, $bytesAlign); |]+ findPtrBT _ = Nothing++ in concatMap (accum findPtrBT) bes++-- | Finds all the NameIDs for which the first (possibly only) instance of some NameID+-- occurs flush with the beginning of the top-level expression (zero bytes distance+subexpFirsts :: BaseExp -> [NameID]+subexpFirsts be = let++ -- INVARIANT of sF: never call on a subexpression that doesn't *start* at the+ -- beginning of the outer-most expression 'be'.+ sF (n ::: e) = n : sF e+ sF (Attr (Contains n) e) = n : sF e+ sF (Attr (BaseType (SizeBT (SizeLit Nothing p))) (Prim{})) = [show p]+ sF (Prim{}) = []+ sF (Con _ e) = sF e+ sF (e :@ _) = sF e+ sF (e1 :+ e2)+ | expSize e1 == Just 0 = sF e1 ++ sF e2+ | otherwise = sF e1 -- Conservative approximation (ignore things in e2 even though expSize is conservative)+ sF (e1 :|| e2) = sF e1 ++ sF e2+ sF (Exists _ e) = sF e+ sF (_ :# e) = sF e -- First instances of 'e' is in 'subexpFirsts be'+ sF (Attr _ e) = sF e++ in sF be++genGetFirstMethods :: [BaseExp] -> [RustItem]+genGetFirstMethods bes = let++ findNamed :: BaseExp -> Maybe RustItem+ findNamed (n ::: e) = Just $ RustImpl (addrName n) (concatMap mkGetFirst $ subexpFirsts e) []+ findNamed _ = Nothing++ mkGetFirst n = let+ get_first = firstGetterName n+ aN = addrName n+ in snd [implItems|+ pub fn $get_first(self) -> $aN {+ $aN::from_usize(self.as_usize())+ } |]++ in concatMap (accum findNamed) bes++type NamedE = (NameID, BaseExp)+type Neighbors = (NamedE, NamedE)++-- | Makes a plain-vanilla pass-by-value paramument with the given type:+mkParam :: BindingMode -> String -> String -> Arg Span+mkParam mode var ty = Arg (Just $ IdentP mode (mkIdent var) Nothing fS) (PathTy Nothing (Path False [PathSegment (mkIdent ty) Nothing fS] fS) fS) fS++mkSelf = SelfRegion Nothing Immutable fS++-- | Makes a plain-vanilla type from a name+mkRustTy :: String -> Ty Span+mkRustTy name = PathTy Nothing (Path False [PathSegment (mkIdent name) Nothing fS] fS) fS++-- List is /all/ the ancestral parents in bottom-up order. NamedE is the child who+-- has the ancesters.+type Ancestry = ([NamedE], NamedE)++genShadowAlloc :: [BaseExp] -> [RustItem]+genShadowAlloc bes = let++ findParentList :: BaseExp -> [Ancestry]+ findParentList be = let+ -- acc is list of parents accumulator along the path from the root to the given BaseExp+ fPL :: [NamedE] -> BaseExp -> [Ancestry]+ fPL acc (prnt ::: e) = (acc, (prnt, e)) : (fPL ((prnt,e) : acc) e)+ fPL acc e = callSub (fPL acc) e+ in fPL [] be+ + filterAncestry :: [Ancestry] -> [Ancestry]+ filterAncestry [] = []+ filterAncestry ((prnts, (cN, cE)) : rest) = let+ + matchingRest :: [Ancestry]+ matchingRest = filter ((== cN) . fst . snd) rest++ notMatchingRest :: [Ancestry]+ notMatchingRest = filter ((/= cN) . fst . snd) rest+ + allPrnts = (prnts ++ (concatMap fst matchingRest))+ in (nub allPrnts, (cN, cE)) : filterAncestry notMatchingRest++ mkShadowAlloc :: Ancestry -> [RustItem]+ mkShadowAlloc (prnts, child) = let+ nBytesIn = bytesName (fst child)+ flp_IDX_NAME = enumName (fst child)+ mkRustName :: NameID -> Expr Span+ mkRustName n = [expr| $n |]+ mkInner =+ -- Static u8 (indices / IDXs) array of the parents of this child+ snd [implItems|+ pub const __FLP_IDX : u8 = $flp_IDX_NAME;+ pub const __FLP_PARENTS : &'static [u8] = & ${e| Vec []+ (map mkRustName $ (map (enumName . fst) prnts) ++ [enumName "UNMAPPED"]) fakeSpan |}; |]+ ++ (case expSize (snd child) of+ Nothing -> -- Variable-size child - caller needs to indicate size + snd [implItems|+ pub fn shadow_alloc_from(&self, bytes: usize, vec_IDX: Vec<u8>) {+ //assert!(Self::__FLP_PARENTS.contains(&IDX));+ //for i in 0 .. bytes {+ // let offset = self.as_usize() + i;+ // check_expect_pc!(offset, &vec_IDX);+ //}+ }+ |]+ Just sz -> if sz == 0 then [] -- Cannot actually shadow allocate something of zero size (no-op)+ else -- Fixed-size child: caller need not indicate the size+ snd [implItems|+ pub fn shadow_alloc_from(&self, vec_IDX: Vec<u8>) {+ //assert!(Self::__FLP_PARENTS.contains(&IDX));+ //for i in 0 .. $nBytesIn {+ // let offset = self.as_usize() + i;+ // check_expect_pc!(offset, &vec_IDX);+ //}+ } |])++ in [RustImpl (addrName $ fst child) mkInner [] ]++ in concatMap mkShadowAlloc (filterAncestry $ concatMap findParentList bes)+ -- in undefined -- concat $ concatMap (accum findParentList) bes++-- | Generate all things pertaining to neighboring names, along with their common parent name.+genNeighborParents :: [BaseExp] -> [RustItem]+genNeighborParents bes = let++ findParent :: BaseExp -> Maybe [RustItem]+ findParent (prnt ::: e) = Just $ mkItems prnt (findNeighbors e)+ ++ fromMaybe [] (mkSeqFns prnt <$> (findSeqs False e))+ ++ mkAddrEndDiff prnt+ ++ fromMaybe [] (mkAllocShadow prnt <$> (findSeqs True e))+ findParent _ = Nothing++ -- Find the canonical sequence of named things+ findSeqs :: Bool -> BaseExp -> Maybe [NamedE]+ findSeqs unwrapAll be = let+ findS :: BaseExp -> Maybe [NamedE]+ findS (Con _ e) = findS e+ findS (e :@ _) = findS e+ findS (Exists _ e) = findS e+ findS (Attr _ e) = findS e+ findS (e1 :+ e2) = findS e1 >>= \a -> findS e2 >>= \b -> pure (a ++ b)+ findS (n ::: e) = Just $ [ (n,e) ]+ findS (e1 :|| e2)+ | unwrapAll = findS e1 >>= \a -> findS e2 >>= \b -> pure (a ++ b)+ | otherwise = Nothing+ findS (_ :# e)+ | unwrapAll = findS e+ | otherwise = Nothing+ findS (Prim{}) = Nothing+ in findS be++ -- | Individually named shadow_alloc_from_*() functions, i.e. for each parent.+ mkAllocShadow :: NameID -> [NamedE] -> [RustItem]+ mkAllocShadow prnt nes = let++ shadow_alloc_fn = "shadow_alloc_from_" ++ firstLower prnt+ + mkImpl ne = RustImpl (addrName $ fst ne) (inner ne) []++ prntConstFLP = enumName prnt++ inner (n, e) =+ let nConstFLP = enumName n+ nBytesIn = bytesName n+ in case expSize e of+ Nothing ->+ [implItem|+ pub fn $shadow_alloc_fn(&self, bytes: usize) {+ //for i in 0..bytes {+ // let offset = self.as_usize() + i;+ // //check_expect_pc!(offset, vec![$prntConstFLP]);+ //}+ } |] : []+ Just sz -> if sz == 0 then [] else+ [implItem|+ pub fn $shadow_alloc_fn(&self) {+ //for i in 0..$nBytesIn {+ // let offset = self.as_usize() + i;+ // //check_expect_pc!(offset, vec![$prntConstFLP]);+ //}+ } |] : []+ + in map mkImpl nes++ -- Functions pertaining to sequences of named things within a parent+ mkSeqFns :: NameID -> [NamedE] -> [RustItem]+ mkSeqFns prnt nes = let+ + init_sequence = initSeqName (map fst nes)++ paramNames = map (\i -> "a" ++ show i) [1 .. length nes]+ paramTypes = map (const "usize") (map fst nes)++ prntEndName = addrEndName prnt++ plusE :: [(String, NamedE)] -> Expr Span+ plusE [] = [expr| self |]+ plusE ((paramName, (fieldName, coreExpr)):ns) =+ [expr| ${e| plusE ns |}.plus::<$fieldName>($paramName) |]++ newParams = mkSelf : map (uncurry $ mkParam (ByValue Immutable)) (zip paramNames paramTypes)+ newRetTy = TupTy (map (mkRustTy . addrName . fst) nes+ ++ [mkRustTy prntEndName]) fS+ newStmts = let+ exprs = (map (plusE . reverse) $ tail $ inits $ zip ("a0" : paramNames) ((map (bimap addrName id)) nes))+ + exprLast = [expr| ${e| last exprs |}.plus::<$prntEndName>(${i| last $ paramNames |}) |]++ in [stmts|+ let a0 : usize = 0;+ let ret = ${e| TupExpr [] (exprs ++ [exprLast]) fS |};+ return ret;+ |]++ -- (FnDecl [Param a] (Maybe (Ty a)) Bool a)+ bareFn = case [implItem| pub fn $init_sequence() -> (Int,) { (3,) } |] of+ (MethodI a1 a2 a3 a4 a5 (MethodSig c1 c2 c3 (FnDecl params (Just ty) bool spn)) (Block stmts b2 b3) a8) ->+ MethodI a1 a2 a3 a4 a5 (MethodSig c1 c2 c3 (FnDecl newParams (Just newRetTy) bool spn)) (Block newStmts b2 b3) a8+ _ -> error "Compiler incompatibility with your version of language-rust package."++ mSF = [ bareFn ]++ in [ RustImpl (addrName prnt) mSF []+ ]++ -- parent name -> [neighbors] -> rust items+ mkItems :: NameID -> [Neighbors] -> [RustItem]+ mkItems prnt ns =+ let !_ = D.traceShowId (prnt, ns)+ in ( RustImpl (structName prnt) (concatMap mkNeighborFns ns) []+ ) : concatMap mkNeighborAddrEndFns ns++ mkNeighborAddrEndFns :: Neighbors -> [RustItem]+ mkNeighborAddrEndFns ((n1, e1), (n2, e2)) = let++ n1EndA = addrEndName n1+ toEndN = "to_" ++ firstUpper n1EndA+ fromEndN = "from_" ++ firstUpper n1EndA+ n2A = addrName n2++ mkN2 = snd $ [implItems|+ pub fn $toEndN(self) -> $n1EndA { $n1EndA::from_usize(self.as_usize()) }+ pub fn $fromEndN(ptr : $n1EndA) -> $n2A { $n2A::from_usize(ptr.as_usize()) }+ |]++ toN2FnN = "to_" ++ firstUpper n2A+ fromN2FnN = "from_" ++ firstUpper n2A++ mkN1End = snd $ [implItems|+ pub fn $toN2FnN(&self) -> $n2A { $n2A::from_usize(self.as_usize()) }+ pub fn $fromN2FnN(ptr : $n2A) -> $n1EndA { $n1EndA::from_usize(ptr.as_usize()) }+ |]++ in [ RustImpl n1EndA mkN1End []+ , RustImpl n2A mkN2 []+ ]++ mkAddrEndDiff :: NameID -> [RustItem]+ mkAddrEndDiff n = let+ nEndA = addrEndName n+ nA = addrName n+ in+ [ RustImpl nA+ (snd [implItems| pub fn size_of(&self, end : $nEndA) -> usize {+ debug_assert!(end.as_usize() >= self.as_usize());+ end.diff(*self)+ } |]) []+ ]++ mkNeighborFns :: Neighbors -> [ImplItem Span]+ mkNeighborFns ((n1, e1), (n2, e2)) = let+ + n1A = addrName n1+ n2A = addrName n2++ init_after = initAfterName n1 n2++ -- | Looks for all (depth = 1) named entities that consume the entire space of the BaseExp+ -- (can't dig into ':+' expressions):+ findWholeChunks :: BaseExp -> [NameID]+ findWholeChunks be = let+ fWC (n ::: _) = [n] -- Don't recurse because depth=1+ fWC (e1 :+ e2)+ | expSize e2 == Just 0 = fWC e1+ | expSize e1 == Just 0 = fWC e2+ | otherwise = [] -- Doesn't consume the entire space+ fWC (_ :# e) = [] -- Doesn't consume the entire space+ fWC e = callSub fWC e -- All other recursive cases+ in fWC be++ poundLeftBumpFn n =+ let bump_new_thing = bumpAllocName n+ aN = addrName n+ in snd $+ [implItems| pub fn $bump_new_thing(rhs : $n2A, bytes : usize) -> ($aN, $n2A) {+ (rhs.plus(0), rhs.plus(bytes))+ }+ |]+ + bump_valid = bumpValidName n1 n2+ bumpValid = snd $+ [implItems| pub fn $bump_valid(p1 : $n1A, p2 : $n2A) -> bool { p1.lte(p2) } |]++ -- Checks that the LHS (e1) was exactly a field containing an array of things, and+ -- makes the function that allows you to bump-allocate a new entry in that array+ -- past the *current* end of the array.+ poundLeftBumpFns = case e1 of+ (Exists _ (_ :# e)) -> concatMap poundLeftBumpFn (findWholeChunks e)+ _ -> []+ + -- The right-hand neighbor is null-sized+ --emptyRight = case expSize e2 of+ -- (Just 0) ->+ -- _ -> []+ + memset_until = memsetUntilName n1 n2+ n1Bytes = bytesName n1++ memsetRange = case expSize e1 of+ Just sz | sz > 0 -> snd [implItems|+ pub fn $memset_until(val : u8, base : $n1A) {+ base.memset(val, $n1Bytes)+ } |]+ | otherwise -> []+ Nothing -> snd [implItems|+ pub fn $memset_until(val : u8, base : $n1A, mx : $n2A) {+ debug_assert!(mx.greater(base));+ base.memset(val, mx.diff(base))+ } |]+ + initAfterFn = (snd $ case expSize e1 of+ Just sz | sz == 0 -> [implItems| pub fn $init_after(p1 : $n1A) -> $n2A { $n2A::from_usize(p1.as_usize()) } |]+ | otherwise -> [implItems| pub fn $init_after(p1 : $n1A) -> $n2A { p1.plus($n1Bytes) } |]+ Nothing -> [implItems| pub fn $init_after(p1 : $n1A, bytes : usize) -> $n2A { p1.plus(bytes) } |])+ + in memsetRange ++ poundLeftBumpFns ++ initAfterFn ++ bumpValid++ findNeighbors :: BaseExp -> [Neighbors]+ findNeighbors be = let++ most :: ((BaseExp, BaseExp) -> BaseExp) -> BaseExp -> [NamedE]+ most fn = let+ most' (n ::: e) = [(n,e)] -- We don't find nested-names (names are boundaries)+ most' (e1 :+ e2) = most' (fn (e1,e2))+ most' (Attr _ e) = most' e+ most' (Prim{}) = []+ most' (Con _ e) = most' e+ most' (e :@ _) = most' e+ most' (e1 :|| e2) = []+ most' (Exists _ e) = most' e+ most' (_ :# e) = []+ in most'+ + left_most :: BaseExp -> [NamedE]+ left_most = most fst+ right_most :: BaseExp -> [NamedE]+ right_most = most snd++ fN :: [NamedE] -> BaseExp -> [NamedE] -> [Neighbors]+ fN left (e1 :+ e2) right = fN left e1 (left_most e2) ++ fN (right_most e1) e2 right+ fN left (n ::: e) right = (zip left (repeat (n,e))) ++ (zip (repeat (n,e)) right)+ fN l (Attr _ e) r = fN l e r+ fN l (Prim{}) r = []+ fN l (Con _ e) r = fN l e r+ fN l (e :@ _) r = fN l e r+ fN l (e1 :|| e2) r = fN [] e1 [] ++ fN [] e2 [] -- We throw away neighbors at unions (for simplicity)+ fN l (Exists _ e) r = fN l e r+ fN l (_ :# e) r = fN [] e [] -- Throw away neighbors at repetitions, because not every instance inside '#' is left-most or right-most+ in nub $ fN [] be []++ in concat $ concatMap (accum findParent) bes++-- | TODO: Remove allow(dead_code) and allow(unused_imports)+(SourceFile _ headerAttrs headerItems) = [sourceFile|+ #![allow(non_camel_case_types)]+ #![allow(non_snake_case)]+ #![allow(dead_code)]+ #![allow(unused_imports)]+ #![allow(unused_variables)]+ extern crate libc;+ extern crate flp_framework;+ use std::cmp;+ use std::fmt;+ use std::mem::size_of as size_of;+ use self::libc::size_t as size_t;+ + pub use self::flp_framework::*;+|]+-- #[macro_use]+-- pub mod address;+-- use self::address::*;++-- writeSourceFile :: (Monoid a, Typeable a) => Handle -> SourceFile a -> IO ()+writeModule :: (Monoid a, Typeable a) => FilePath -> SourceFile a -> IO ()+writeModule outdir sf = do+ fd <- openFile outdir WriteMode+ writeSourceFile fd sf+ hClose fd+
+ src/Language/Floorplan/Rust/Mapping.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, BangPatterns #-}+module Language.Floorplan.Rust.Mapping+ where+{- Code generator for mappings due to same-named repetitions in a FLP spec.+ -}++import Language.Rust.Parser as P+import Language.Rust.Syntax as R hiding (Byte)+import Language.Rust.Quote+import Language.Rust.Data.Ident+import Language.Rust.Data.Position++import Language.Floorplan.Syntax(SizeArith(..), Primitive(..))+import Language.Floorplan.Core.Syntax+import Language.Floorplan.Rust.Types+import Language.Floorplan.Rust.Common++import Data.Functor ( ($>) )+import Data.Ord (comparing)+import Data.List (sortBy, nub)+import Data.Char (toUpper, toLower)+import qualified Debug.Trace as D++genFixedWidthStructs :: [BaseExp] -> [Item Span]+genFixedWidthStructs bes = let++ gFWS (n ::: e) = let sN = structName n in Just $ case expSize e of+ Nothing -> [items| #[derive(Copy, Clone)]+ pub struct $sN( () ); // Unit type!!!+ |]+ Just sz -> [items|+ #[derive(Copy, Clone)]+ pub struct $sN([u8; ${e| mkIntExp sz |}]);++ impl PartialEq for $sN {+ #[inline(always)] fn eq(&self, other: &$sN) -> bool {+ for i in 0..(size_of::<$sN>()) {+ if self.0[i] != other.0[i] { return false; }+ }+ return true;+ }+ #[inline(always)] fn ne(&self, other: &$sN) -> bool {+ for i in 0..(size_of::<$sN>()) {+ if self.0[i] != other.0[i] { return true; }+ }+ return false;+ }+ } + |]+ gFWS _ = Nothing++ in nub $ concat $ concatMap (accum gFWS) bes++genMaps :: [BaseExp] -> [RustItem]+genMaps bes =+ let findExistBind :: BaseExp -> Maybe [RustItem]+ findExistBind (outerName ::: e) = + Just $ concatMap (mkMapFns outerName) (findExists e)+ findExistBind _ = Nothing++ -- [ImplItem Span]+ mkMapFns :: NameID -> BaseExp -> [RustItem]+ mkMapFns oN (Exists n e) = let++ nameOf Byte = "Byte" -- "u8" TODO: replace all bytes with 'u8'+ nameOf x = show x++ -- TODO: mkMF should be a more principled pre-processing pass (find pairs that work):+ mkMF (Attr (BaseType (SizeBT (SizeLit Nothing p1))) e1+ , Attr (BaseType (SizeBT (SizeLit Nothing p2))) e2) = mkMF' (nameOf p1) e1 (nameOf p2) e2+ mkMF (Attr (BaseType (SizeBT (SizeLit Nothing p1))) e1, n2 ::: e2) = mkMF' (nameOf p1) e1 n2 e2+ mkMF (n1 ::: e1, (Attr (BaseType (SizeBT (SizeLit Nothing p2))) e2)) = mkMF' n1 e1 (nameOf p2) e2+ mkMF (Attr _ e1, e2) = mkMF (e1, e2)+ mkMF (e1, Attr _ e2) = mkMF (e1, e2)+ mkMF (n1 ::: e1, n2 ::: e2) = mkMF' n1 e1 n2 e2+ mkMF _ = []+ + mkMF' n1 e1 n2 e2 = let++ (Just sz1) = expSize e1+ (Just sz2) = expSize e2++ tsfm = n1 ++ "2" ++ n2+ startNameAddr = addrName n1+ toNameAddr = addrName n2+ toName = structName n2++ outerAddr = addrName oN++ idxExpr+ | isPow2 sz1 = [expr| (elem.as_usize() - base.as_usize()) >> ${e| mkIntExp $ log2 sz1 |} |]+ | otherwise = [expr| (elem.as_usize() - base.as_usize()) / ${e| mkIntExp sz1 |} |]+ + tsfmExpr+ | isPow2 sz1 = [expr| (idx << ${e| mkIntExp $ log2 sz1 |}) |]+ | otherwise = [expr| (idx * sz1) |]+ idxTsfm =+ [implItem|+ #[inline(always)]+ pub fn $thing_from_idx(base: $startNameAddr, idx: usize) -> $startNameAddr {+ let result = $startNameAddr::from_usize(base.as_usize() + ${e| tsfmExpr |});+ result+ }+ |]++ assocItems = [items|+ pub struct $tsfm+ { pub fromStart : $startNameAddr+ , pub toStart : $toNameAddr+ }+ |]++ thing_from_idx = fromIdxName n1+ idx_from_thing = toIdxName n1++ innerItems = idxTsfm : snd [implItems|+ #[inline(always)]+ pub fn new(fromStart: $startNameAddr, toStart: $toNameAddr) -> $tsfm {+ $tsfm { fromStart, toStart }+ }++ #[inline(always)]+ pub fn set(&self+ , fromAddr : $startNameAddr+ , value : $toName) { Self::map_set(self.fromStart, self.toStart, fromAddr, value) }+ + #[inline(always)]+ pub fn getAddr(&self+ , fromAddr : $startNameAddr+ ) -> $toNameAddr { Self::map_getAddr(self.fromStart, self.toStart, fromAddr) }+ + #[inline(always)]+ pub fn get(&self+ , fromAddr : $startNameAddr+ ) -> $toName { Self::map_get(self.fromStart, self.toStart, fromAddr) }++ #[inline(always)]+ pub fn idx(base : $startNameAddr, elem : $startNameAddr) -> usize {+ debug_assert!(elem >= base);+ //LET Sz1 = ${e| mkIntExp sz1 |};+ // This can be checked on addresses themselves to enforce alignment as-is:+ //debug_assert!(((elem.as_usize() - base.as_usize()) % sz1) == 0);+ let result = ${e| idxExpr |};+ result+ }++ #[inline(always)]+ pub fn map_set( fromStart : $startNameAddr+ , toStart : $toNameAddr+ , fromAddr : $startNameAddr+ , value : $toName) {+ let idxV = $tsfm::idx(fromStart, fromAddr);+ toStart.offset::<$toName, $toNameAddr>(idxV).store(value)+ }+ + #[inline(always)]+ pub fn map_set_idx(+ toStart : $toNameAddr+ , idxV : usize+ , value : $toName) {+ toStart.offset::<$toName, $toNameAddr>(idxV).store(value)+ }+ + #[inline(always)]+ pub fn map_get_idx(+ toStart : $toNameAddr+ , idxV : usize) -> $toName {+ toStart.offset::<$toName, $toNameAddr>(idxV).load()+ }+ + #[inline(always)]+ pub fn map_getAddr( fromStart : $startNameAddr+ , toStart : $toNameAddr+ , fromAddr : $startNameAddr+ ) -> $toNameAddr {+ let idxV = $tsfm::idx(fromStart, fromAddr);+ toStart.offset::<$toName, $toNameAddr>(idxV)+ }+ + #[inline(always)]+ pub fn map_get( fromStart : $startNameAddr+ , toStart : $toNameAddr+ , fromAddr : $startNameAddr+ ) -> $toName {+ let idxV = $tsfm::idx(fromStart, fromAddr);+ toStart.offset::<$toName, $toNameAddr>(idxV).load()+ }+ |]+ -- #[inline(always)]+ -- let result = 3; //${e|idxExpr|};+ -- debug_assert!(((elem.as_usize() - base.as_usize()) % (${e| mkIntExp sz1 |})) == 0);+ -- result+ --+ in [ RustImpl tsfm innerItems assocItems ]++ in concatMap mkMF $ D.traceShowId $ allPairs n e++ allPairs :: NameID -> BaseExp -> [(BaseExp, BaseExp)]+ allPairs n e = let+ + -- Find references to a repetition with the given name,+ -- without crossing shadowed scope boundaries:+ findRep (Prim{}) = []+ findRep (Con _ e2) = findRep e2+ findRep (e2 :@ _) = findRep e2+ findRep (e2 :+ e3) = findRep e2 ++ findRep e3+ findRep (e2 :|| e3) = findRep e2 ++ findRep e3+ findRep (_ ::: e2) = findRep e2+ findRep (Exists n2 e2)+ | n == n2 = []+ | otherwise = findRep e2+ findRep e2@(n2 :# e3)+ | n == n2 = e3 : findRep e3+ | otherwise = findRep e3+ findRep (Attr _ e2) = findRep e2+ + xs = findRep e+ in [ (x,y)+ | (x,i) <- zip xs [1..length xs]+ , (y,j) <- zip xs [1..length xs]+ , expSize x /= Nothing+ , expSize y /= Nothing+ , i /= j+ ]++ in concat $ concatMap (accum findExistBind) bes+
+ src/Language/Floorplan/Rust/Types.hs view
@@ -0,0 +1,24 @@+module Language.Floorplan.Rust.Types+ where+import Language.Rust.Parser as P+import Language.Rust.Syntax as R+import Language.Rust.Quote+import Language.Rust.Data.Ident+import Language.Rust.Data.Position++import Language.Floorplan.Core.Syntax++-- | Stripped-down Rust Impl item with just the pieces we+-- care about (name and item entries) so that we can merge lists of impls+-- together by NameID equality.+data RustItem =+ RustImpl+ NameID -- ^ e.g. "CellAddr"+ [ImplItem Span] -- ^ Contents of the Impl+ [Item Span] -- ^ Associated Items that go *outside* the `impl`+ | TopLevel [Item Span]+ deriving (Show)++rustItemComparator (RustImpl n _ _) = n+rustItemComparator (TopLevel _) = "______________________FLP__" -- TODO+
+ src/Language/Floorplan/Semantics.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveDataTypeable #-}+module Language.Floorplan.Semantics where++import Data.Maybe (fromJust)+import Language.Floorplan.Core.Syntax++data Tree =+ T Tree Tree+ | N String Tree+ | B0 | B1+ deriving (Eq, Ord, Show)++leaves (T t1 t2) = leaves t1 + leaves t2+leaves (N _ t) = leaves t+leaves B0 = 0+leaves B1 = 1++addStep s xs = map (\(r,d) -> (r, s : d)) xs++g p0 p1 p2 p3 = let++ g' a m theta ((:+) e1 e2) =+ let params = \r1 -> (a + leaves r1, m - leaves r1, theta, e2)+ in+ [ (T r1 r2, ("Plus: i = 0.." ++ show m ++ ", Pause (g " ++ show (params r1) ++ ")") : deriv1+ ++ ["Resume (g " ++ show (params r1) ++ ")" ++ ", leaves r1 = " ++ show (leaves r1)] ++ deriv2)+ | (r1, deriv1) <- concat [ addStep ("Plus_r1: Choose i=" ++ show i) $ g a i theta e1 | i <- [0..m]]+ , (r2, deriv2) <- addStep ("Plus_r2: leaves(" ++ show e1 ++ ")=" ++ show (leaves r1)) $ g (a + leaves r1) (m - leaves r1) theta e2+ ]+ g' a m theta ((:||) e1 e2) = let+ r1 = addStep ("Or_e1") (g a m theta e1)+ r2 = addStep ("Or_e2") (g a m theta e2)+ in r1 ++ r2+ g' a m theta (Prim n)+ | m == n = [(foldl T B0 (take n $ repeat B1), ["Prim: Evaluate " ++ show n ++ "-leaf tree"])]+ | otherwise = []+ g' a m theta (Con n e)+ | m == n = addStep ("Con: " ++ show n) (g a m theta e)+ | m /= n = []+ g' a m theta ((:@) e aln)+ | a `mod` aln == 0 = g a m theta e+ | otherwise = []+ g' a m theta ((:::) l e) =+ [ (N l r, ("HasType: " ++ l) : deriv)+ | (r, deriv) <- g a m theta e+ ]+ g' a m theta (Exists f e) = concat+ [ addStep ("Exists: Choose " ++ f ++ "=" ++ show i)+ $ g a m ((f, i) : theta) e | i <- [0 .. m] ]+ g' a m theta ((:#) f e)+ | (Just m) == lookup f theta && m == 0 = [(T B0 B0, ["Pound: m = 0"])]+ | (Just 0) == lookup f theta = []+ | otherwise = let -- Implies lookup theta f > 0+ params = \r1 -> (a + leaves r1, m - leaves r1, (f, (fromJust $ lookup f theta) - 1) : theta, (:#) f e)+ in case lookup f theta of+ Nothing -> error "Nothing"+ Just thetaF -> [ (T r1 r2, ("Pound: theta(" ++ f ++ ")=" ++ show thetaF ++ ", Pause (g " ++ show (params r1)) : deriv1+ ++ ["Resume (g " ++ show (params r1) ++ ")"] ++ deriv2)+ | (r1, deriv1) <- concat [addStep ("Pound_r1: Choose i=" ++ show i) $ g a i theta e | i <- [0..m]]+ , (r2, deriv2) <- addStep ("Pound_r2: leaves(" ++ show e ++ ")=" ++ show (leaves r1)) $+ g (a + leaves r1) (m - leaves r1) ((f, (fromJust $ lookup f theta) - 1) : theta) ((:#) f e)+ ]++ addLabel (r, d:ds) = (r, (d ++ "[[g " ++ show (p0, p1, p2, p3) ++ "]] ") : ds)++ in map addLabel (g' p0 p1 p2 p3)+
+ src/Language/Floorplan/Syntax.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveDataTypeable #-}+module Language.Floorplan.Syntax where++import Data.Maybe (maybeToList)++type LayerID = String -- upper+type FormalID = String -- lower+type FlagID = String -- upper+type FieldID = String -- lower++data Primitive = Page | Word | Byte | Bit+ deriving (Eq, Ord, Show)++lexeme2prim "page" = Just Page+lexeme2prim "pages" = Just Page+lexeme2prim "word" = Just Word+lexeme2prim "words" = Just Word+lexeme2prim "byte" = Just Byte+lexeme2prim "bytes" = Just Byte+lexeme2prim "bit" = Just Bit+lexeme2prim "bits" = Just Bit+lexeme2prim _ = Nothing++instance Read Primitive where+ readsPrec _ input = case lexeme2prim input of+ Just x -> [(x,"")]+ Nothing -> []++data Demarc =+ Enum [FlagID]+ | Bits [(FieldID, SizeArith)]+ | Union [Demarc]+ | Seq [Demarc]+ | PtrF FieldID+ | PtrL LayerID+ | Blob SizeArith+ | Graft (LayerID, [Arg])+ | Field FieldID Demarc+ | Pound Demarc+ | Repetition FormalID Demarc+ | Layer+ { name :: LayerID+ , formals :: [FormalID]+ , magnitude :: Maybe SizeArith+ , alignment :: Maybe SizeArith+ , magAlign :: Maybe SizeArith+ , contains :: [LayerID]+ , rhs :: Demarc+ }+ deriving (Eq, Ord, Show)++free_vars :: Demarc -> [FormalID]+free_vars d@(Enum{}) = []+free_vars d@(Bits{}) = []+free_vars d@(Union ds) = concatMap free_vars ds+free_vars d@(Seq ds) = concatMap free_vars ds+free_vars d@(PtrF{}) = []+free_vars d@(PtrL{}) = []+free_vars d@(Blob{}) = []+free_vars d@(Graft{}) = []+free_vars f@(Field _ d) = free_vars d+free_vars p@(Pound d) = free_vars d+free_vars r@(Repetition f d) = f : free_vars d+free_vars d@(Layer{}) =+ [ fv+ | fv <- free_vars (rhs d)+ , fv `notElem` formals d+ ]++accum :: (Demarc -> Maybe a) -> Demarc -> [a]+accum fn d@(Enum{}) = maybeToList (fn d)+accum fn d@(Bits{}) = maybeToList (fn d)+accum fn d@(Union ds) = maybeToList (fn d) ++ concatMap (accum fn) ds+accum fn d@(Seq ds) = maybeToList (fn d) ++ concatMap (accum fn) ds+accum fn d@(PtrF{}) = maybeToList (fn d)+accum fn d@(PtrL{}) = maybeToList (fn d)+accum fn d@(Blob{}) = maybeToList (fn d)+accum fn d@(Graft{}) = maybeToList (fn d)+accum fn f@(Field _ d) = maybeToList (fn f) ++ accum fn d+accum fn p@(Pound d) = maybeToList (fn p) ++ accum fn d+accum fn r@(Repetition _ d) = maybeToList (fn r) ++ accum fn d+accum fn d@(Layer{}) = maybeToList (fn d) ++ accum fn (rhs d)++countMatches :: (Demarc -> Bool) -> Demarc -> Int+countMatches fn demarc = length $ (flip accum) demarc $ \d -> if fn d then Just 1 else Nothing++-- | Bool is whether or not anything was changed (so no need to do Eq check in fixed-point transformations)+fmapD :: (Demarc -> (Demarc, Bool)) -> Demarc -> (Demarc, Bool)+fmapD fncn d@(Enum{}) = fncn d+fmapD fncn d@(Bits{}) = fncn d+fmapD fncn d@(Union ds) = let ds' = map (fmapD fncn) ds+ (d', b) = fncn (Union $ map fst ds')+ in (d', or (b : map snd ds'))+fmapD fncn d@(Seq ds) = let ds' = map (fmapD fncn) ds+ (d', b) = fncn (Seq $ map fst ds')+ in (d', or (b : map snd ds'))+fmapD fncn d@(PtrF{}) = fncn d+fmapD fncn d@(PtrL{}) = fncn d+fmapD fncn d@(Blob{}) = fncn d+fmapD fncn d@(Graft{}) = fncn d+fmapD fncn (Field f d) = let (d', b') = fmapD fncn d+ (d'', b'') = fncn (Field f d')+ in (d'', b' || b'')+fmapD fncn (Pound d) = let (d', b') = fmapD fncn d+ (d'', b'') = fncn (Pound d')+ in (d'', b' || b'')+fmapD fncn (Repetition f d) = let (d', b') = fmapD fncn d+ (d'', b'') = fncn (Repetition f d')+ in (d'', b' || b'')+fmapD fncn d@(Layer{}) = let (rhs', b') = fmapD fncn $ rhs d+ (d'', b'') = fncn (d { rhs = rhs' })+ in (d'', b' || b'')++data Arg =+ ArgL Literal + | ArgF FormalID+ deriving (Eq, Ord, Show)++type Literal = Int++bin2int :: String -> Int+bin2int ('0':'b':xs) = let+ b2i [] = 0+ b2i (b:bs) = (read [b]) + (2 * b2i bs)+ in b2i $ reverse xs++data LitArith =+ Plus LitArith LitArith+ | Minus LitArith LitArith+ | Times LitArith LitArith+ | Div LitArith LitArith+ | Exponent LitArith LitArith+ | Lit Literal+ deriving (Eq, Ord, Show)++data SizeArith =+ SizePlus SizeArith SizeArith+ | SizeMinus SizeArith SizeArith+ | SizeLit (Maybe LitArith) Primitive+ deriving (Eq, Ord, Show)+
+ src/Language/Floorplan/Token.x view
@@ -0,0 +1,95 @@+{+{-# OPTIONS_GHC -w #-}+module Language.Floorplan.Token (Token(..), scanTokens) where+import Language.Floorplan.Syntax+}++%wrapper "basic"++$digit = 0-9+$alpha = [a-zA-Z]+$eol = [\n]++tokens :-+ $eol ;+ $white+ ;+ "//".* ;+ seq { \s -> TokenSeq }+ union { \s -> TokenUnion }+ contains { \s -> TokenContains }+ bits { \s -> TokenBits }+ bytes { \s -> TokenBytes }+ words { \s -> TokenWords }+ pages { \s -> TokenPages }+ ptr { \s -> TokenPtr }+ enum { \s -> TokenEnum }+ "->" { \s -> TokenArrow }+ "@(" { \s -> TokenAtParen }+ ")@" { \s -> TokenParenAt }+ "@|" { \s -> TokenAtBar }+ "|@" { \s -> TokenBarAt }+ "<$" { \s -> TokenLessD }+ "$>" { \s -> TokenGreaterD }+ \( { \s -> TokenLParen }+ \) { \s -> TokenRParen }+ \< { \s -> TokenLess }+ \> { \s -> TokenGreater }+ \| { \s -> TokenBar }+ \|\| { \s -> TokenBarBar }+ \{ { \s -> TokenLCurl }+ \} { \s -> TokenRCurl }+ \# { \s -> TokenPound }+ \: { \s -> TokenColon }+ \, { \s -> TokenComma }+ [\+] { \s -> TokenPlus }+ [\-] { \s -> TokenMinus }+ [\*] { \s -> TokenTimes }+ [\/] { \s -> TokenDiv }+ [\^] { \s -> TokenExponent }+ $digit+ { \s -> TokenNum (read s) }+ 0b [01]+ { \s -> TokenNum (bin2int s) }+ [a-z] [$alpha $digit \_]* { \s -> TokenLowerID s }+ [A-Z] [$alpha $digit \_]* { \s -> TokenUpperID s}++{+data Token =+ TokenSeq+ | TokenUnion+ | TokenContains+ | TokenBits+ | TokenBytes+ | TokenWords+ | TokenPages+ | TokenPtr+ | TokenEnum+ | TokenArrow+ | TokenAtParen+ | TokenParenAt+ | TokenAtBar+ | TokenBarAt+ | TokenLParen+ | TokenRParen+ | TokenLess+ | TokenGreater+ | TokenLessD+ | TokenGreaterD+ | TokenBar+ | TokenBarBar+ | TokenLCurl+ | TokenRCurl+ | TokenPound+ | TokenColon+ | TokenComma+ | TokenPlus+ | TokenMinus+ | TokenTimes+ | TokenDiv+ | TokenExponent+ | TokenNum Int+ | TokenUpperID String+ | TokenLowerID String+ deriving (Eq, Ord, Show)++scanTokens = alexScanTokens+}+
+ src/Language/Rust/Data/Ident.hs view
@@ -0,0 +1,94 @@+{-|+Module : Language.Rust.Data.Ident+Description : Identifiers+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++Data structure behind identifiers.+-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}++module Language.Rust.Data.Ident (Ident(..), mkIdent, Name, IdentName(..) ) where++import GHC.Generics ( Generic )++import Control.DeepSeq ( NFData )+import Data.Data ( Data )+import Data.Typeable ( Typeable )++import Data.List ( foldl' )+import Data.Char ( ord )+import Data.String ( IsString(..) )+--import Data.Semigroup as Sem++-- | An identifier+data Ident+ = Ident { name :: IdentName -- ^ payload of the identifier+ , raw :: Bool -- ^ whether the identifier is raw+ , hash :: {-# UNPACK #-} !Int -- ^ hash for quick comparision+ } deriving (Data, Typeable, Generic, NFData)++-- | Shows the identifier as a string (for use with @-XOverloadedStrings@)+instance Show Ident where+ show = show . name++instance IsString Ident where+ fromString = mkIdent++-- | Uses 'hash' to short-circuit+instance Eq Ident where+ i1 == i2 = hash i1 == hash i2 && name i1 == name i2 && raw i1 == raw i2+ i1 /= i2 = hash i1 /= hash i2 || name i1 /= name i2 || raw i1 /= raw i2++-- | Uses 'hash' to short-circuit+instance Ord Ident where+ compare i1 i2 = case compare i1 i2 of+ EQ -> compare (raw i1, name i1) (raw i2, name i2)+ rt -> rt++-- | "Forgets" about whether either argument was raw+instance Monoid Ident where+ mappend = (<>)+ mempty = mkIdent ""++-- | "Forgets" about whether either argument was raw+-- <<<<<<< HEAD+instance Semigroup Ident where+ Ident (Name n1) _ _ <> Ident (Name n2) _ _ = mkIdent (n1 <> n2)+ Ident (HaskellName n1) _ _ <> Ident (HaskellName n2) _ _ = mkIdent (n1 <> n2)+ Ident (Name n1) _ _ <> Ident (HaskellName n2) _ _ = mkIdent (n1 <> n2)+ Ident (HaskellName n1) _ _ <> Ident (Name n2) _ _ = mkIdent (n1 <> n2)+-- =======+-- instance Sem.Semigroup Ident where+-- Ident n1 _ _ <> Ident n2 _ _ = mkIdent (n1 <> n2)+-- >>>>>>> upstream/master++-- | Smart constructor for making an 'Ident'.+mkIdent :: String -> Ident+mkIdent ('$':'{':'i':'|':ss) = Ident (HaskellName $ init $ init ss) False (hashString $ init $ init ss)+mkIdent s = Ident (Name s) False (hashString s)++-- | Hash a string into an 'Int'+hashString :: String -> Int+hashString = foldl' f golden+ where f m c = fromIntegral (ord c) * magic + m+ magic = 0xdeadbeef+ golden = 1013904242++-- | The payload of an identifier+type Name = String++data IdentName =+ Name Name+ | HaskellName String+ deriving (Eq, Ord, Data, Typeable, Generic, NFData)++instance Show IdentName where+ show (Name n) = show n+ show (HaskellName n) = "${i|" ++ n ++ "|}"+
+ src/Language/Rust/Data/InputStream.hs view
@@ -0,0 +1,170 @@+{-|+Module : Language.Rust.Data.InputStream+Description : Interface to the underlying input of parsing+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++These are the only functions that need to be implemented in order to use the parser. Whether this+wraps 'BS.ByteString' or 'String' depends on whether the @useByteStrings@ option is on or not (it is+by default). Using 'BS.ByteString' means better handling of weird characters ('takeByte' for plain+'String' fails badly if you try to take a byte that doesn't fall on a character boundary), but it+means incurring a dependency on the [utf8-string](https://hackage.haskell.org/package/utf8-string)+package.+-}+{-# LANGUAGE CPP #-}++module Language.Rust.Data.InputStream (+ -- * InputStream type+ InputStream,+ countLines,+ inputStreamEmpty,+ + -- * Introduction forms+ readInputStream,+ hReadInputStream,+ inputStreamFromString,+ + -- * Elimination forms+ inputStreamToString,+ takeByte,+ takeChar,+ peekChars,+) where++import Data.Word ( Word8 )+import Data.Coerce ( coerce )+import Data.String ( IsString(..) )+import System.IO++#ifdef USE_BYTESTRING+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as BE+#else+import qualified Data.Char as Char+#endif++-- | Read an encoded file into an 'InputStream'+readInputStream :: FilePath -> IO InputStream+{-# INLINE readInputStream #-}++-- | Read an 'InputStream' from a 'Handle'+hReadInputStream :: Handle -> IO InputStream+{-# INLINE hReadInputStream #-}++-- | Convert 'InputStream' to 'String'.+inputStreamToString :: InputStream -> String+{-# INLINE inputStreamToString #-}++-- | Convert a 'String' to an 'InputStream'.+inputStreamFromString :: String -> InputStream+{-# INLINE inputStreamFromString #-}++-- | Uses 'inputStreamFromString'+instance IsString InputStream where fromString = inputStreamFromString++-- | Read the first byte from an 'InputStream' and return that byte with what remains of the+-- 'InputStream'. Behaviour is undefined when 'inputStreamEmpty' returns 'True'.+--+-- >>> takeByte "foo bar"+-- (102, "oo bar")+--+-- >>> takeByte "Ĥăƨĸëļļ"+-- (196, "\ETX\168\&8\235<<")+--+takeByte :: InputStream -> (Word8, InputStream)+{-# INLINE takeByte #-}++-- | Read the first character from an 'InputStream' and return that 'Char' with what remains of the+-- 'InputStream'. Behaviour is undefined when 'inputStreamEmpty' returns 'True'.+--+-- >>> takeChar "foo bar"+-- ('f', "oo bar")+--+-- >>> takeChar "Ĥăƨĸëļļ"+-- ('Ĥ', "ăƨĸëļļ")+--+takeChar :: InputStream -> (Char, InputStream)+{-# INLINE takeChar #-}++-- | Return @True@ if the given input stream is empty.+--+-- >>> inputStreamEmpty ""+-- True+--+-- >>> inputStreamEmpty "foo"+-- False+--+inputStreamEmpty :: InputStream -> Bool+{-# INLINE inputStreamEmpty #-}++-- | Returns the first @n@ characters of the given input stream, without removing them.+--+-- >>> peekChars 5 "foo bar"+-- "foo ba"+--+-- >>> peekChars 5 "foo"+-- "foo"+--+-- >>> peekChars 3 "Ĥăƨĸëļļ"+-- "Ĥăƨ"+--+peekChars :: Int -> InputStream -> String+{-# INLINE peekChars #-}++-- | Returns the number of text lines in the given 'InputStream'+--+-- >>> countLines ""+-- 0+--+-- >>> countLines "foo"+-- 1+--+-- >>> countLines "foo\n\nbar"+-- 3+--+-- >>> countLines "foo\n\nbar\n"+-- 3+--+countLines :: InputStream -> Int+{-# INLINE countLines #-}++#ifdef USE_BYTESTRING++-- | Opaque input type.+newtype InputStream = IS BS.ByteString deriving (Eq, Ord)+takeByte bs = (BS.head (coerce bs), coerce (BS.tail (coerce bs)))+takeChar bs = maybe (error "takeChar: no char left") coerce (BE.uncons (coerce bs))+inputStreamEmpty = BS.null . coerce+peekChars n = BE.toString . BE.take n . coerce+readInputStream f = coerce <$> BS.readFile f+hReadInputStream h = coerce <$> BS.hGetContents h+inputStreamToString = BE.toString . coerce+inputStreamFromString = IS . BE.fromString +countLines = length . BE.lines . coerce++instance Show InputStream where+ show (IS bs) = show bs++#else++-- | Opaque input type.+newtype InputStream = IS String deriving (Eq, Ord)+takeByte (IS ~(c:str))+ | Char.isLatin1 c = let b = fromIntegral (Char.ord c) in b `seq` (b, IS str)+ | otherwise = error "takeByte: not a latin-1 character"+takeChar (IS ~(c:str)) = (c, IS str)+inputStreamEmpty (IS str) = null str+peekChars n (IS str) = take n str+readInputStream f = IS <$> readFile f+hReadInputStream h = IS <$> hGetContents h+inputStreamToString = coerce+inputStreamFromString = IS+countLines (IS str) = length . lines $ str++instance Show InputStream where+ show (IS bs) = show bs++#endif
+ src/Language/Rust/Data/Position.hs view
@@ -0,0 +1,220 @@+{-|+Module : Language.Rust.Data.Position+Description : Positions and spans in files+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++Everything to do with describing a position or a contiguous region in a file.+-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}++module Language.Rust.Data.Position (+ -- * Positions in files+ Position(..),+ prettyPosition,+ maxPos,+ minPos,+ initPos,+ incPos,+ retPos,+ incOffset,++ -- * Spans in files+ Span(..),+ unspan,+ prettySpan,+ subsetOf,+ (#),+ Spanned(..),+ Located(..),+) where++import GHC.Generics ( Generic )++import Control.DeepSeq ( NFData )+import Data.Data ( Data )+import Data.Typeable ( Typeable )++import Language.Rust.Parser.NonEmpty ( NonEmpty(..) )+import Data.Monoid as Mon+import Data.Semigroup as Sem++-- | A position in a source file. The row and column information is kept only for its convenience+-- and human-readability. Analogous to the information encoded in a cursor.+data Position = Position {+ absoluteOffset :: {-# UNPACK #-} !Int, -- ^ absolute offset the source file.+ row :: {-# UNPACK #-} !Int, -- ^ row (line) in the source file.+ col :: {-# UNPACK #-} !Int -- ^ column in the source file.+ }+ | NoPosition+ deriving (Eq, Ord, Data, Typeable, Generic, NFData)++-- | Field names are not shown+instance Show Position where+ showsPrec _ NoPosition = showString "NoPosition"+ showsPrec p (Position a r c) = showParen (p >= 11) + ( showString "Position"+ . showString " " . showsPrec 11 a+ . showString " " . showsPrec 11 r+ . showString " " . showsPrec 11 c )++-- | Pretty print a 'Position'+prettyPosition :: Position -> String+prettyPosition NoPosition = "???"+prettyPosition (Position _ r c) = show r ++ ":" ++ show c++-- | Maximum of two positions, bias for actual positions.+--+-- >>> maxPos (Position 30 5 8) (Position 37 5 15)+-- Position 37 5 15+--+-- >>> maxPos NoPosition (Position 30 5 8)+-- Position 30 5 8+--+{-# INLINE maxPos #-}+maxPos :: Position -> Position -> Position+maxPos NoPosition p2 = p2+maxPos p1 NoPosition = p1+maxPos p1@(Position a1 _ _) p2@(Position a2 _ _) = if a1 > a2 then p1 else p2++-- | Maximum and minimum positions, bias for actual positions.+--+-- >>> minPos (Position 30 5 8) (Position 37 5 15)+-- Position 30 5 8+--+-- >>> minPos NoPosition (Position 30 5 8)+-- Position 30 5 8+--+{-# INLINE minPos #-}+minPos :: Position -> Position -> Position+minPos NoPosition p2 = p2+minPos p1 NoPosition = p1+minPos p1@(Position a1 _ _) p2@(Position a2 _ _) = if a1 < a2 then p1 else p2++-- | Starting position in a file.+{-# INLINE initPos #-}+initPos :: Position+initPos = Position 0 1 0++-- | Advance column a certain number of times.+{-# INLINE incPos #-}+incPos :: Position -> Int -> Position+incPos NoPosition _ = NoPosition+incPos p@Position{ absoluteOffset = a, col = c } offset = p { absoluteOffset = a + offset, col = c + offset }++-- | Advance to the next line.+{-# INLINE retPos #-}+retPos :: Position -> Position+retPos NoPosition = NoPosition+retPos (Position a r _) = Position { absoluteOffset = a + 1, row = r + 1, col = 1 }++-- | Advance only the absolute offset, not the row and column information. Only use this if you+-- know what you are doing!+{-# INLINE incOffset #-}+incOffset :: Position -> Int -> Position+incOffset NoPosition _ = NoPosition+incOffset p@Position{ absoluteOffset = a } offset = p { absoluteOffset = a + offset }++-- | Spans represent a contiguous region of code, delimited by two 'Position's. The endpoints are+-- inclusive. Analogous to the information encoded in a selection.+data Span = Span { lo, hi :: !Position }+ deriving (Eq, Ord, Data, Typeable, Generic, NFData)++-- | Field names are not shown +instance Show Span where+ showsPrec p (Span l h) = showParen (p >= 11) + ( showString "Span"+ . showString " " . showsPrec 11 l+ . showString " " . showsPrec 11 h )+++-- | Check if a span is a subset of another span+subsetOf :: Span -> Span -> Bool+Span l1 h1 `subsetOf` Span l2 h2 = minPos l1 l2 == l1 && maxPos h1 h2 == h2++-- | Convenience function lifting 'Mon.<>' to work on all 'Located' things+{-# INLINE (#) #-}+(#) :: (Located a, Located b) => a -> b -> Span+left # right = spanOf left Mon.<> spanOf right++-- | smallest covering 'Span'+instance Sem.Semigroup Span where+ {-# INLINE (<>) #-}+ Span l1 h1 <> Span l2 h2 = Span (l1 `minPos` l2) (h1 `maxPos` h2)++instance Mon.Monoid Span where+ {-# INLINE mempty #-}+ mempty = Span NoPosition NoPosition++ {-# INLINE mappend #-}+ mappend = (Sem.<>)++-- | Pretty print a 'Span'+prettySpan :: Span -> String+prettySpan (Span lo' hi') = show lo' ++ " - " ++ show hi'++-- | A "tagging" of something with a 'Span' that describes its extent.+data Spanned a = Spanned a {-# UNPACK #-} !Span+ deriving (Eq, Ord, Data, Typeable, Generic, NFData)++-- | Extract the wrapped value from 'Spanned'+{-# INLINE unspan #-}+unspan :: Spanned a -> a+unspan (Spanned x _) = x++instance Functor Spanned where+ {-# INLINE fmap #-}+ fmap f (Spanned x s) = Spanned (f x) s++instance Applicative Spanned where+ {-# INLINE pure #-}+ pure x = Spanned x mempty+ + {-# INLINE (<*>) #-}+ Spanned f s1 <*> Spanned x s2 = Spanned (f x) (s1 Sem.<> s2)++instance Monad Spanned where+ return = pure+ Spanned x s1 >>= f = let Spanned y s2 = f x in Spanned y (s1 Sem.<> s2)++instance Show a => Show (Spanned a) where+ show = show . unspan+++-- | Describes nodes that can be located - their span can be extracted from them. In general, we+-- expect that for a value constructed as @Con x y z@ where @Con@ is an arbitrary constructor+--+-- prop> (spanOf x <> spanOf y <> spanOf z) `subsetOf` spanOf (Con x y z) == True+--+class Located a where+ spanOf :: a -> Span++instance Located Span where+ {-# INLINE spanOf #-}+ spanOf = id++instance Located (Spanned a) where+ {-# INLINE spanOf #-}+ spanOf (Spanned _ s) = s++instance Located a => Located (Maybe a) where+ {-# INLINE spanOf #-}+ spanOf = foldMap spanOf++-- | /O(n)/ time complexity+instance Located a => Located [a] where+ {-# INLINE spanOf #-}+ spanOf = foldMap spanOf++-- | /O(n)/ time complexity+instance Located a => Located (NonEmpty a) where+ {-# INLINE spanOf #-}+ spanOf = foldMap spanOf++
+ src/Language/Rust/Parser.hs view
@@ -0,0 +1,153 @@+{-|+Module : Language.Rust.Parser+Description : Parsing and lexing+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++Selecting the right parser may require adding an annotation or using @-XTypeApplications@ to avoid+an "Ambiguous type variable" error.++Using 'Control.Monad.void' (as in the examples below) exploits the fact that most AST nodes are+instances of 'Functor' to discard the 'Span' annotation that is attached to most parsed AST nodes.+Conversely, if you wish to extract the 'Span' annotation, the 'Language.Rust.Syntax.AST.Located'+typeclass provides a 'Language.Rust.Syntax.AST.spanOf' method.++The examples below assume the following GHCi flags and imports:++>>> :set -XTypeApplications -XOverloadedStrings+>>> import Language.Rust.Syntax.AST+>>> import Control.Monad ( void )+>>> import System.IO++-}+{-# LANGUAGE FlexibleInstances #-}++module Language.Rust.Parser (+ -- * Parsing+ parse,+ parse',+ readSourceFile,+ readTokens,+ Parse(..),+ P,+ execParser,+ execParserTokens,+ initPos,+ Span,++ -- * Lexing+ lexToken,+ lexNonSpace,+ lexTokens,+ translateLit,++ -- * Input stream+ readInputStream,+ hReadInputStream,+ inputStreamToString,+ inputStreamFromString,++ -- * Error reporting+ lexicalError,+ parseError,+ ParseFail(..),+) where++import Language.Rust.Syntax++import Language.Rust.Data.InputStream+import Language.Rust.Data.Position ( Position, Span, Spanned, initPos )++import Language.Rust.Parser.Internal+import Language.Rust.Parser.Lexer ( lexToken, lexNonSpace, lexTokens, lexicalError )+import Language.Rust.Parser.Literals ( translateLit )+import Language.Rust.Parser.ParseMonad ( P, execParser, parseError, pushToken, ParseFail(..) )++import Control.Exception ( throw )+import Data.Foldable ( traverse_ )+import System.IO ( Handle )++-- | Parse something from an input stream (it is assumed the initial position is 'initPos').+--+-- >>> fmap void $ parse @(Expr Span) "x + 1"+-- Right (Binary [] AddOp (PathExpr [] Nothing (Path False [PathSegment "x" Nothing ()] ()) ())+-- (Lit [] (Int Dec 1 Unsuffixed ()) ())+-- ())+--+-- >>> fmap void $ parse @(Expr Span) "x + "+-- Left (parse failure at 1:4 (Syntax error: unexpected `<EOF>' (expected an expression)))+--+parse :: Parse a => InputStream -> Either ParseFail a+parse is = execParser parser is initPos++-- | Same as 'parse', but throws a 'ParseFail' exception if it cannot parse. This function is+-- intended for situations in which you are already stuck catching exceptions - otherwise you should+-- prefer 'parse'.+--+-- >>> void $ parse' @(Expr Span) "x + 1"+-- Binary [] AddOp (PathExpr [] Nothing (Path False [PathSegment "x" Nothing ()] ()) ())+-- (Lit [] (Int Dec 1 Unsuffixed ()) ())+-- ()+--+-- >>> void $ parse' @(Expr Span) "x + "+-- *** Exception: parse failure at 1:4 (Syntax error: unexpected `<EOF>' (expected an expression))+--+parse' :: Parse a => InputStream -> a+parse' = either throw id . parse++-- | Same as 'execParser', but working from a list of tokens instead of an 'InputStream'.+execParserTokens :: P a -> [Spanned Token] -> Position -> Either ParseFail a+execParserTokens p toks = execParser (pushTokens toks *> p) (inputStreamFromString "")+ where pushTokens = traverse_ pushToken . reverse++-- | Given a handle to a Rust source file, read that file and parse it into a 'SourceFile'+--+-- >>> writeFile "empty_main.rs" "fn main() { }"+-- >>> fmap void $ withFile "empty_main.rs" ReadMode readSourceFile+-- SourceFile Nothing [] [Fn [] InheritedV "main"+-- (FnDecl [] Nothing False ())+-- Normal NotConst Rust+-- (Generics [] [] (WhereClause [] ()) ())+-- (Block [] Normal ()) ()]+--+readSourceFile :: Handle -> IO (SourceFile Span)+readSourceFile hdl = parse' <$> hReadInputStream hdl++-- | Given a path pointing to a Rust source file, read that file and lex it (ignoring whitespace)+--+-- >>> writeFile "empty_main.rs" "fn main() { }"+-- >>> withFile "empty_main.rs" ReadMode readTokens+-- [fn,main,(,),{,}]+--+readTokens :: Handle -> IO [Spanned Token]+readTokens hdl = do+ inp <- hReadInputStream hdl+ case execParser (lexTokens lexNonSpace) inp initPos of+ Left pf -> throw pf+ Right x -> pure x++-- | Describes things that can be parsed+class Parse a where+ -- | Complete parser (fails if not all of the input is consumed)+ parser :: P a++instance Parse (Lit Span) where parser = parseLit+instance Parse (Attribute Span) where parser = parseAttr+instance Parse (Ty Span) where parser = parseTy +instance Parse (Pat Span) where parser = parsePat+instance Parse (Expr Span) where parser = parseExpr+instance Parse (Stmt Span) where parser = parseStmt+instance Parse (Item Span) where parser = parseItem+instance Parse (SourceFile Span) where parser = parseSourceFile+instance Parse TokenTree where parser = parseTt+instance Parse TokenStream where parser = parseTokenStream+instance Parse (Block Span) where parser = parseBlock+instance Parse (ImplItem Span) where parser = parseImplItem +instance Parse (TraitItem Span) where parser = parseTraitItem+instance Parse (TyParam Span) where parser = parseTyParam+instance Parse (LifetimeDef Span) where parser = parseLifetimeDef+instance Parse (Generics Span) where parser = parseGenerics+instance Parse (WhereClause Span) where parser = parseWhereClause
+ src/Language/Rust/Parser/Internal.y view
@@ -0,0 +1,2123 @@+{+{-|+Module : Language.Rust.Parser.Internal+Description : Rust parser+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++The parsers in this file are all re-exported to 'Language.Rust.Parser' via the 'Parse' class. The+parsers are based off of:++ * primarily the reference @rustc@ [implementation][0]+ * some documentation on [rust-lang][2]+ * drawing a couple ideas from a slightly outdated [ANTLR grammar][1]++To get information about transition states and such, run++> happy --info=happyinfo.txt -o /dev/null src/Language/Rust/Parser/Internal.y++ [0]: https://github.com/rust-lang/rust/blob/master/src/libsyntax/parse/parser.rs+ [1]: https://github.com/rust-lang/rust/blob/master/src/grammar/parser-lalr.y+ [2]: https://doc.rust-lang.org/grammar.html+-}+{-# OPTIONS_HADDOCK hide, not-home #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}++module Language.Rust.Parser.Internal (+ -- * Parsers+ parseAttr,+ parseBlock,+ parseExpr,+ parseGenerics,+ parseImplItem,+ parseItem,+ parseLifetimeDef,+ parseLit,+ parsePat,+ parseSourceFile,+ parseStmt,+ parseTokenStream,+ parseTraitItem,+ parseTt,+ parseTy,+ parseTyParam,+ parseWhereClause,+ parseStmts,+ parseItems,+ parseImplItems,+) where++import Language.Rust.Syntax++import Language.Rust.Data.Ident ( Ident(..), mkIdent, IdentName(..) )+import Language.Rust.Data.Position++import Language.Rust.Parser.Lexer ( lexNonSpace, lexShebangLine )+import Language.Rust.Parser.ParseMonad ( pushToken, getPosition, P, parseError )+import Language.Rust.Parser.Literals ( translateLit )+import Language.Rust.Parser.Reversed++import Data.Foldable ( toList )+import Data.List ( (\\), isSubsequenceOf, sort )+import Data.Semigroup ( (<>) )++import Text.Read ( readMaybe )++import Language.Rust.Parser.NonEmpty ( NonEmpty(..), (<|), (|>), (|:) )+import qualified Language.Rust.Parser.NonEmpty as N+}++-- in order to document the parsers, we have to alias them+%name parseLit lit+%name parseAttr export_attribute+%name parseTy ty+%name parsePat pat+%name parseStmt stmt+%name parseExpr expr+%name parseItem mod_item+%name parseSourceFileContents source_file+%name parseBlock export_block+%name parseImplItem impl_item+%name parseTraitItem trait_item+%name parseTt token_tree+%name parseTokenStream token_stream+%name parseTyParam ty_param+%name parseLifetimeDef lifetime_def+%name parseWhereClause where_clause+%name parseGenerics generics++%name parseStmts stmts+%name parseItems mod_items+%name parseImplItems impl_items++%tokentype { Spanned Token }+%lexer { lexNonSpace >>= } { Spanned Eof _ }+%monad { P } { >>= } { return }++%errorhandlertype explist+%error { expParseError }++%expect 0++%token++ -- Expression-operator symbols.+ '=' { Spanned Equal _ }+ '<' { Spanned Less _ }+ '>' { Spanned Greater _ }+ '!' { Spanned Exclamation _ }+ '~' { Spanned Tilde _ }++ '+' { Spanned Plus _ }+ '-' { Spanned Minus _ }+ '*' { Spanned Star _ }+ '/' { Spanned Slash _ }+ '%' { Spanned Percent _ }+ '^' { Spanned Caret _ }+ '&' { Spanned Ampersand _ }+ '|' { Spanned Pipe _ }++ -- Structural symbols.+ '@' { Spanned At _ }+ '...' { Spanned DotDotDot _ }+ '..=' { Spanned DotDotEqual _ }+ '..' { Spanned DotDot _ }+ '.' { Spanned Dot _ }+ ',' { Spanned Comma _ }+ ';' { Spanned Semicolon _ }+ '::' { Spanned ModSep _ }+ ':' { Spanned Colon _ }+ '->' { Spanned RArrow _ }+ '<-' { Spanned LArrow _ }+ '=>' { Spanned FatArrow _ }+ '#' { Spanned Pound _ }+ '$' { Spanned Dollar _ }+ '?' { Spanned Question _ }+ '#!' { Spanned Shebang _ }++ '||' { Spanned PipePipe _ }+ '&&' { Spanned AmpersandAmpersand _ }+ '>=' { Spanned GreaterEqual _ }+ '>>=' { Spanned GreaterGreaterEqual _ }+ '<<' { Spanned LessLess _ }+ '>>' { Spanned GreaterGreater _ }++ '==' { Spanned EqualEqual _ }+ '!=' { Spanned NotEqual _ }+ '<=' { Spanned LessEqual _ }+ '<<=' { Spanned LessLessEqual _ }+ '-=' { Spanned MinusEqual _ }+ '&=' { Spanned AmpersandEqual _ }+ '|=' { Spanned PipeEqual _ }+ '+=' { Spanned PlusEqual _ }+ '*=' { Spanned StarEqual _ }+ '/=' { Spanned SlashEqual _ }+ '^=' { Spanned CaretEqual _ }+ '%=' { Spanned PercentEqual _ }++ '(' { Spanned (OpenDelim Paren) _ }+ '[' { Spanned (OpenDelim Bracket) _ }+ '{' { Spanned (OpenDelim Brace) _ }+ ')' { Spanned (CloseDelim Paren) _ }+ ']' { Spanned (CloseDelim Bracket) _ }+ '}' { Spanned (CloseDelim Brace) _ }++ -- Embedded code+ EMBEDDED_EXPR { Spanned (EmbeddedCode _) _ }+ EMBEDDED_IDENT { Spanned (EmbeddedIdent _) _ }++ -- Literals.+ byte { Spanned (LiteralTok ByteTok{} _) _ }+ char { Spanned (LiteralTok CharTok{} _) _ }+ int { Spanned (LiteralTok IntegerTok{} _) _ }+ float { Spanned (LiteralTok FloatTok{} _) _ }+ str { Spanned (LiteralTok StrTok{} _) _ }+ byteStr { Spanned (LiteralTok ByteStrTok{} _) _ }+ rawStr { Spanned (LiteralTok StrRawTok{} _) _ }+ rawByteStr { Spanned (LiteralTok ByteStrRawTok{} _) _ }++ -- Strict keywords used in the language+ as { Spanned (IdentTok "as") _ }+ box { Spanned (IdentTok "box") _ }+ break { Spanned (IdentTok "break") _ }+ const { Spanned (IdentTok "const") _ }+ continue { Spanned (IdentTok "continue") _ }+ crate { Spanned (IdentTok "crate") _ }+ else { Spanned (IdentTok "else") _ }+ enum { Spanned (IdentTok "enum") _ }+ extern { Spanned (IdentTok "extern") _ }+ false { Spanned (IdentTok "false") _ }+ fn { Spanned (IdentTok "fn") _ }+ for { Spanned (IdentTok "for") _ }+ if { Spanned (IdentTok "if") _ }+ impl { Spanned (IdentTok "impl") _ }+ in { Spanned (IdentTok "in") _ }+ let { Spanned (IdentTok "let") _ }+ loop { Spanned (IdentTok "loop") _ }+ match { Spanned (IdentTok "match") _ }+ mod { Spanned (IdentTok "mod") _ }+ move { Spanned (IdentTok "move") _ }+ mut { Spanned (IdentTok "mut") _ }+ pub { Spanned (IdentTok "pub") _ }+ ref { Spanned (IdentTok "ref") _ }+ return { Spanned (IdentTok "return") _ }+ Self { Spanned (IdentTok "Self") _ }+ self { Spanned (IdentTok "self") _ }+ static { Spanned (IdentTok "static") _ }+ struct { Spanned (IdentTok "struct") _ }+ super { Spanned (IdentTok "super") _ }+ trait { Spanned (IdentTok "trait") _ }+ true { Spanned (IdentTok "true") _ }+ type { Spanned (IdentTok "type") _ }+ unsafe { Spanned (IdentTok "unsafe") _ }+ use { Spanned (IdentTok "use") _ }+ where { Spanned (IdentTok "where") _ }+ while { Spanned (IdentTok "while") _ }+ do { Spanned (IdentTok "do") _ }++ -- Keywords reserved for future use+ abstract { Spanned (IdentTok "abstract") _ }+ alignof { Spanned (IdentTok "alignof") _ }+ become { Spanned (IdentTok "become") _ }+ final { Spanned (IdentTok "final") _ }+ macro { Spanned (IdentTok "macro") _ }+ offsetof { Spanned (IdentTok "offsetof") _ }+ override { Spanned (IdentTok "override") _ }+ priv { Spanned (IdentTok "priv") _ }+ proc { Spanned (IdentTok "proc") _ }+ pure { Spanned (IdentTok "pure") _ }+ sizeof { Spanned (IdentTok "sizeof") _ }+ typeof { Spanned (IdentTok "typeof") _ }+ unsized { Spanned (IdentTok "unsized") _ }+ virtual { Spanned (IdentTok "virtual") _ }++ -- Weak keywords, have special meaning only in specific contexts.+ default { Spanned (IdentTok "default") _ }+ union { Spanned (IdentTok "union") _ }+ catch { Spanned (IdentTok "catch") _ }+ auto { Spanned (IdentTok "auto") _ }+ yield { Spanned (IdentTok "yield") _ }+ dyn { Spanned (IdentTok "dyn") _ }++ -- Comments+ outerDoc { Spanned (Doc _ Outer _) _ }+ innerDoc { Spanned (Doc _ Inner _) _ }++ -- Identifiers.+ '_' { Spanned (IdentTok "_") _ }+ IDENT { Spanned IdentTok{} _ }++ -- Lifetimes.+ LIFETIME { Spanned (LifetimeTok _) _ }++ -- Interpolated+ ntItem { Spanned (Interpolated (NtItem $$)) _ }+ ntBlock { Spanned (Interpolated (NtBlock $$)) _ }+ ntStmt { Spanned (Interpolated (NtStmt $$)) _ }+ ntPat { Spanned (Interpolated (NtPat $$)) _ }+ ntExpr { Spanned (Interpolated (NtExpr $$)) _ }+ ntTy { Spanned (Interpolated (NtTy $$)) _ }+ ntIdent { Spanned (Interpolated (NtIdent _)) _ }+ ntPath { Spanned (Interpolated (NtPath $$)) _ }+ ntTT { Spanned (Interpolated (NtTT $$)) _ }+ ntArm { Spanned (Interpolated (NtArm $$)) _ }+ ntImplItem { Spanned (Interpolated (NtImplItem $$)) _ }+ ntTraitItem { Spanned (Interpolated (NtTraitItem $$)) _ }+ ntGenerics { Spanned (Interpolated (NtGenerics $$)) _ }+ ntWhereClause { Spanned (Interpolated (NtWhereClause $$)) _ }+ ntArg { Spanned (Interpolated (NtArg $$)) _ }+ ntLit { Spanned (Interpolated (NtLit $$)) _ }++-- 'SEG' needs to be lower than '::' for path segments+%nonassoc SEG++-- 'mut' needs to be lower precedence than 'IDENT' so that in 'pat', something like "&mut x"+-- associates the "mut" to a refence pattern and not to the identifier pattern "x".+--+-- 'DEF' is for the empty case of 'def', which needs to _not_ be taken when there is a 'default'+-- token available.+--+-- 'EQ' is for differentiating the 'where ty' from 'where ty = ty' case in where clause+-- predicates, since the former needs to _not_ be taken when there is a '=' token available.+--+-- '::' is so that the remainder of mod paths in attributes are not gobbled as just raw tokens+%nonassoc mut DEF EQ '::'++-- These are all identifiers of sorts ('union' and 'default' are "weak" keywords)+%nonassoc IDENT ntIdent default union catch self Self super auto dyn crate++-- These are all very low precedence unary operators+%nonassoc box return yield break continue for IMPLTRAIT LAMBDA++-- 'static' needs to have higher precedenc than 'LAMBDA' so that statements starting in static get+-- considered as static items, and not a static lambda+%nonassoc static++-- These are the usual arithmetic precedences. 'UNARY' is introduced here for '*', '!', '-', '&'+%right '=' '>>=' '<<=' '-=' '+=' '*=' '/=' '^=' '|=' '&=' '%='+%right '<-'+%nonassoc SINGLERNG+%nonassoc INFIXRNG+%nonassoc POSTFIXRNG+%nonassoc PREFIXRNG+%nonassoc '..' '...' '..='+%left '||'+%left '&&'+%left '==' '!=' '<' '>' '<=' '>='+%left '|'+%left '^'+%left '&'+%left '<<' '>>'+%left '+' '-'+%left '*' '/' '%'+%nonassoc ':' as+%nonassoc UNARY++-- These are all generated precedence tokens.+--+-- * 'FIELD' for field access expressions (which bind less tightly than '.' for method calls)+-- * 'VIS' for adjusting the precedence of 'pub' compared to other visbility modifiers (see 'vis')+-- * 'PATH' boosts the precedences of paths in types and expressions+-- * 'WHERE' is for non-empty where clauses+--+%nonassoc FIELD VIS PATH WHERE NOSEMI++-- These are postfix operators.+%nonassoc '?' '.'++-- Delimiters have the highest precedence. 'ntBlock' counts as a delimiter since it always starts+-- and ends with '{' and '}'+%nonassoc '{' ntBlock '[' '(' '!' ';'++%%++-- Unwraps the IdentTok into just an Ident+-- For questionable reasons of backwards compatibility, 'union', 'default', and 'catch' can be used+-- as identifiers, even if they are also keywords. They are "contextual" keywords.+--+-- Union's RFC: https://github.com/rust-lang/rfcs/blob/master/text/1444-union.md+ident :: { Spanned Ident }+ : ntIdent { fmap (\(Interpolated (NtIdent i)) -> i) $1 }+ | union { toIdent $1 }+ | default { toIdent $1 }+ | catch { toIdent $1 }+ | auto { toIdent $1 }+ | dyn { toIdent $1 }+ | IDENT { toIdent $1 }+ | EMBEDDED_IDENT { let (Spanned (EmbeddedIdent i) s) = $1 in Spanned (mkIdent ("${i|" ++ i ++ "|}")) s }++binding_mode1_ident :: { Spanned Ident }+ : ntIdent { fmap (\(Interpolated (NtIdent i)) -> i) $1 }+ | union { toIdent $1 }+ | default { toIdent $1 }+ | catch { toIdent $1 }+ | auto { toIdent $1 }+ | dyn { toIdent $1 }+ | IDENT { toIdent $1 }++-- This should precede any '>' token which could be absorbed in a '>>', '>=', or '>>=' token. Its+-- purpose is to check if the lookahead token starts with '>' but contains more that. If that is+-- the case, it pushes two tokens, the first of which is '>'. We exploit the %% feature of threaded+-- lexers to discard what would have been the troublesome '>>', '>=', or '>>=' token.+gt :: { () }+ : {- empty -} {%% \(Spanned tok s) ->+ let s' = nudge 1 0 s; s'' = nudge 0 (-1) s in+ case tok of+ GreaterGreater -> pushToken (Spanned Greater s') *> pushToken (Spanned Greater s'')+ GreaterEqual -> pushToken (Spanned Equal s') *> pushToken (Spanned Greater s'')+ GreaterGreaterEqual -> pushToken (Spanned GreaterEqual s') *> pushToken (Spanned Greater s'')+ _ -> pushToken (Spanned tok s)+ }++-- This should precede any '|' token which could be absorbed in a '||' token. This works in the same+-- way as 'gt'.+pipe :: { () }+ : {- empty -} {%% \(Spanned tok s) -> + let s' = nudge 1 0 s; s'' = nudge 0 (-1) s in+ case tok of+ PipePipe -> pushToken (Spanned Pipe s') *> pushToken (Spanned Pipe s'')+ _ -> pushToken (Spanned tok s)+ }++-------------+-- Utility --+-------------++-- | One or more occurences of 'p'+some(p) :: { Reversed NonEmpty p }+ : some(p) p { let Reversed xs = $1 in Reversed ($2 <| xs) }+ | p { [$1] }++-- | Zero or more occurences of 'p'+many(p) :: { [ p ] }+ : some(p) { toList $1 }+ | {- empty -} { [] }++-- | One or more occurences of 'p', seperated by 'sep'+sep_by1(p,sep) :: { Reversed NonEmpty p }+ : sep_by1(p,sep) sep p { let Reversed xs = $1 in Reversed ($3 <| xs) }+ | p { [$1] }++-- | Zero or more occurrences of 'p', separated by 'sep'+sep_by(p,sep) :: { [ p ] }+ : sep_by1(p,sep) { toList $1 }+ | {- empty -} { [] }++-- | One or more occurrences of 'p', seperated by 'sep', optionally ending in 'sep'+sep_by1T(p,sep) :: { Reversed NonEmpty p }+ : sep_by1(p,sep) sep { $1 }+ | sep_by1(p,sep) { $1 }++-- | Zero or more occurences of 'p', seperated by 'sep', optionally ending in 'sep' (only if there+-- is at least one 'p')+sep_byT(p,sep) :: { [ p ] }+ : sep_by1T(p,sep) { toList $1 }+ | {- empty -} { [] }+++--------------------------+-- Whole file+--------------------------++-- shebang is dealt with at the top level, outside Happy/Alex+source_file :: { ([Attribute Span],[Item Span]) }+ : inner_attrs many(mod_item) { (toList $1, $2) }+ | many(mod_item) { ([], $1) }+++--------------------------+-- Attributes+--------------------------++outer_attribute :: { Attribute Span }+ : '#' '[' mod_path token_stream_no_embed ']' { Attribute Outer $3 $4 ($1 # $>) }+ | outerDoc { let Spanned (Doc str _ l) x = $1 in SugaredDoc Outer l str x }++inner_attribute :: { Attribute Span }+ : '#' '!' '[' mod_path token_stream_no_embed ']' { Attribute Inner $4 $5 ($1 # $>) }+ | '#!' '[' mod_path token_stream_no_embed ']' { Attribute Inner $3 $4 ($1 # $>) }+ | innerDoc { let Spanned (Doc str _ l) x = $1 in SugaredDoc Inner l str x }++-- TODO: for some precedence related reason, using 'some' here doesn't work+inner_attrs :: { Reversed NonEmpty (Attribute Span) }+ : inner_attrs inner_attribute { let Reversed xs = $1 in Reversed ($2 <| xs) }+ | inner_attribute { [$1] }+++--------------+-- Literals --+--------------++lit :: { Lit Span }+ : ntLit { $1 }+ | byte { lit $1 }+ | char { lit $1 }+ | int { lit $1 }+ | float { lit $1 }+ | true { lit $1 }+ | false { lit $1 }+ | string { $1 }++string :: { Lit Span }+ : str { lit $1 }+ | rawStr { lit $1 }+ | byteStr { lit $1 }+ | rawByteStr { lit $1 }+++-----------+-- Paths --+-----------++-- parse_qualified_path(PathStyle::Type)+-- qual_path :: Spanned (NonEmpty (Ident, PathParameters Span)) -> P (Spanned (QSelf Span, Path Span))+qual_path(segs) :: { Spanned (QSelf Span, Path Span) }+ : '<' qual_path_suf(segs) { let Spanned x _ = $2 in Spanned x ($1 # $2) }+ | lt_ty_qual_path as ty_path '>' '::' segs {+ let Path g segsTy x = $3 in+ Spanned (QSelf (unspan $1) (length segsTy), Path g (segsTy <> toList $6) x) ($1 # $>)+ }++-- Basically a qualified path, but ignoring the very first '<' token+qual_path_suf(segs) :: { Spanned (QSelf Span, Path Span) }+ : ty '>' '::' segs { Spanned (QSelf $1 0, Path False (toList $4) (spanOf $4)) ($1 # $>) }+ | ty as ty_path '>' '::' segs {+ let Path g segsTy x = $3 in+ Spanned (QSelf $1 (length segsTy), Path g (segsTy <> toList $6) x) ($1 # $>) + }++-- Usually qual_path_suf is for... type paths! This consumes these but with a starting '<<' token.+-- The underlying type has the right 'Span' (it doesn't include the very first '<', while the+-- 'Spanned' wrapper does) +lt_ty_qual_path :: { Spanned (Ty Span) }+ : '<<' qual_path_suf(path_segments_without_colons)+ { let (qself,path) = unspan $2 in Spanned (PathTy (Just qself) path (nudge 1 0 ($1 # $2))) ($1 # $2) }++-- parse_generic_args() but with the '<' '>'+generic_values :: { Spanned ([Lifetime Span], [Ty Span], [(Ident, Ty Span)]) }+ : '<' sep_by1(lifetime,',') ',' sep_by1(ty,',') ',' sep_by1T(binding,',') gt '>'+ { Spanned (toList $2, toList $4, toList $6) ($1 # $>) }+ | '<' sep_by1(lifetime,',') ',' sep_by1T(ty,',') gt '>'+ { Spanned (toList $2, toList $4, [] ) ($1 # $>) }+ | '<' sep_by1(lifetime,',') ',' sep_by1T(binding,',') gt '>'+ { Spanned (toList $2, [], toList $4) ($1 # $>) }+ | '<' sep_by1T(lifetime,',') gt '>'+ { Spanned (toList $2, [], [] ) ($1 # $>) }+ | '<' sep_by1(ty,',') ',' sep_by1T(binding,',') gt '>'+ { Spanned ([], toList $2, toList $4) ($1 # $>) }+ | '<' sep_by1T(ty,',') gt '>'+ { Spanned ([], toList $2, [] ) ($1 # $>) }+ | '<' sep_by1T(binding,',') gt '>'+ { Spanned ([], [], toList $2) ($1 # $>) }+ | '<' gt '>'+ { Spanned ([], [], [] ) ($1 # $>) }+ | lt_ty_qual_path ',' sep_by1(ty,',') ',' sep_by1T(binding,',') gt '>'+ { Spanned ([], unspan $1 : toList $3, toList $5) ($1 # $>) }+ | lt_ty_qual_path ',' sep_by1T(ty,',') gt '>'+ { Spanned ([], unspan $1 : toList $3, [] ) ($1 # $>) }+ | lt_ty_qual_path ',' sep_by1T(binding,',') gt '>'+ { Spanned ([], [unspan $1],toList $3) ($1 # $>) }+ | lt_ty_qual_path gt '>'+ { Spanned ([], [unspan $1],[] ) ($1 # $>) }++binding :: { (Ident, Ty Span) }+ : ident '=' ty { (unspan $1, $3) }+++-- Type related:+-- parse_path(PathStyle::Type)+ty_path :: { Path Span }+ : ntPath { $1 }+ | path_segments_without_colons { Path False $1 (spanOf $1) }+ | '::' path_segments_without_colons { Path True $2 ($1 # $2) }++ty_qual_path :: { Spanned (QSelf Span, Path Span) }+ : qual_path(path_segments_without_colons) { $1 }++-- parse_path_segments_without_colons()+path_segments_without_colons :: { [PathSegment Span] }+ : sep_by1(path_segment_without_colons, '::') %prec SEG { toList $1 }++-- No corresponding function - see path_segments_without_colons+path_segment_without_colons :: { PathSegment Span }+ : self_or_ident path_parameter { PathSegment (unspan $1) $2 ($1 # $>) }++path_parameter :: { Maybe (PathParameters Span) }+ : generic_values { let (lts, tys, bds) = unspan $1+ in Just (AngleBracketed lts tys bds (spanOf $1)) }+ | '(' sep_byT(ty,',') ')' { Just (Parenthesized $2 Nothing ($1 # $>)) }+ | '(' sep_byT(ty,',') ')' '->' ty_no_plus { Just (Parenthesized $2 (Just $>) ($1 # $>)) }+ | {- empty -} %prec IDENT { Nothing }+++-- Expression related:+-- parse_path(PathStyle::Expr)+expr_path :: { Path Span }+ : ntPath { $1 }+ | path_segments_with_colons { Path False (toList $1) (spanOf $1) }+ | '::' path_segments_with_colons { Path True (toList $2) ($1 # $2) }++expr_qual_path :: { Spanned (QSelf Span, Path Span) }+ : qual_path(path_segments_with_colons) { $1 }++-- parse_path_segments_with_colons()+path_segments_with_colons :: { Reversed NonEmpty (PathSegment Span) }+ : self_or_ident+ { [PathSegment (unspan $1) Nothing (spanOf $1)] }+ | path_segments_with_colons '::' self_or_ident+ { $1 <> [PathSegment (unspan $3) Nothing (spanOf $3)] }+ | path_segments_with_colons '::' generic_values+ {%+ case (unsnoc $1, unspan $3) of+ ((rst, PathSegment i Nothing x), (lts, tys, bds)) ->+ let seg = PathSegment i (Just (AngleBracketed lts tys bds (spanOf $3))) (x # $3)+ in pure $ snoc rst seg + _ -> fail "invalid path segment in expression path"+ }++-- Mod related:+-- parse_path(PathStyle::Mod)+--+-- TODO: This is O(n^2) in the segment length! I haven't been able to make the grammar work out in+-- order to refactor this nicely+mod_path :: { Path Span }+ : ntPath { $1 }+ | self_or_ident { Path False [PathSegment (unspan $1) Nothing (spanOf $1)] (spanOf $1) }+ | '::' self_or_ident { Path True [PathSegment (unspan $2) Nothing (spanOf $2)] ($1 # $>) }+ | mod_path '::' self_or_ident {+ let Path g segs _ = $1 in+ Path g (segs <> [PathSegment (unspan $3) Nothing (spanOf $3) ]) ($1 # $3)+ }++self_or_ident :: { Spanned Ident }+ : ident { $1 }+ | crate { Spanned "crate" (spanOf $1) }+ | self { Spanned "self" (spanOf $1) }+ | Self { Spanned "Self" (spanOf $1) }+ | super { Spanned "super" (spanOf $1) }+++-----------+-- Types --+-----------++lifetime :: { Lifetime Span }+ : LIFETIME { let Spanned (LifetimeTok (Ident (Name l) _ _)) s = $1 in Lifetime l s }++-- parse_trait_ref()+trait_ref :: { TraitRef Span }+ : ty_path { TraitRef $1 }++-- parse_ty()+-- See https://github.com/rust-lang/rfcs/blob/master/text/0438-precedence-of-plus.md+-- All types, including trait types with plus+ty :: { Ty Span }+ : ty_no_plus { $1 }+ | poly_trait_ref_mod_bound '+' sep_by1T(ty_param_bound_mod,'+') { TraitObject ($1 <| toNonEmpty $3) ($1 # $3) }++-- parse_ty_no_plus()+ty_no_plus :: { Ty Span }+ : ntTy { $1 }+ | no_for_ty { $1 }+ | for_ty_no_plus { $1 }++-- All types not starting with a '(' or '<'+ty_prim :: { Ty Span }+ : no_for_ty_prim { $1 }+ | for_ty_no_plus { $1 }+ | poly_trait_ref_mod_bound '+' sep_by1T(ty_param_bound_mod,'+') { TraitObject ($1 <| toNonEmpty $3) ($1 # $3) }++-- All (non-sum) types not starting with a 'for'+no_for_ty :: { Ty Span }+ : no_for_ty_prim { $1 }+ | '(' ')' { TupTy [] ($1 # $2) }+ | '(' ty ')' { ParenTy $2 ($1 # $3) }+ | '(' ty ',' ')' { TupTy [$2] ($1 # $4) }+ | '(' ty ',' sep_by1T(ty,',') ')' { TupTy ($2 : toList $4) ($1 # $5) }+ | ty_qual_path { PathTy (Just (fst (unspan $1))) (snd (unspan $1)) (spanOf $1) }++-- All (non-sum) types not starting with a 'for', '(', or '<'+no_for_ty_prim :: { Ty Span }+ : '_' { Infer (spanOf $1) }+ | '!' { Never (spanOf $1) }+ | '[' ty ']' { Slice $2 ($1 # $3) }+ | '*' ty_no_plus { Ptr Immutable $2 ($1 # $2) }+ | '*' const ty_no_plus { Ptr Immutable $3 ($1 # $3) }+ | '*' mut ty_no_plus { Ptr Mutable $3 ($1 # $3) }+ | '&' ty_no_plus { Rptr Nothing Immutable $2 ($1 # $>) }+ | '&' lifetime ty_no_plus { Rptr (Just $2) Immutable $3 ($1 # $>) }+ | '&' mut ty_no_plus { Rptr Nothing Mutable $3 ($1 # $>) }+ | '&' lifetime mut ty_no_plus { Rptr (Just $2) Mutable $4 ($1 # $>) }+ | '&&' ty_no_plus { Rptr Nothing Immutable (Rptr Nothing Immutable $2 (nudge 1 0 ($1 # $>))) ($1 # $>) }+ | '&&' lifetime ty_no_plus { Rptr Nothing Immutable (Rptr (Just $2) Immutable $3 (nudge 1 0 ($1 # $>))) ($1 # $>) }+ | '&&' mut ty_no_plus { Rptr Nothing Immutable (Rptr Nothing Mutable $3 (nudge 1 0 ($1 # $>))) ($1 # $>) }+ | '&&' lifetime mut ty_no_plus { Rptr Nothing Immutable (Rptr (Just $2) Mutable $4 (nudge 1 0 ($1 # $>))) ($1 # $>) }+ | ty_path %prec PATH { PathTy Nothing $1 ($1 # $>) }+ | ty_mac { MacTy $1 ($1 # $>) }+ | unsafe extern abi fn fn_decl(arg_general) { BareFn Unsafe $3 [] $> ($1 # $>) }+ | unsafe fn fn_decl(arg_general) { BareFn Unsafe Rust [] $> ($1 # $>) }+ | extern abi fn fn_decl(arg_general) { BareFn Normal $2 [] $> ($1 # $>) }+ | fn fn_decl(arg_general) { BareFn Normal Rust [] $> ($1 # $>) }+ | typeof '(' expr ')' { Typeof $3 ($1 # $>) }+ | '[' ty ';' expr ']' { Array $2 $4 ($1 # $>) }+ | '?' trait_ref { TraitObject [TraitTyParamBound (PolyTraitRef [] $2 (spanOf $2)) Maybe ($1 # $2)] ($1 # $2) }+ | '?' for_lts trait_ref { TraitObject [TraitTyParamBound (PolyTraitRef (unspan $2) $3 ($2 # $3)) Maybe ($1 # $3)] ($1 # $3) }+ | impl sep_by1(ty_param_bound_mod,'+') %prec IMPLTRAIT { ImplTrait (toNonEmpty $2) ($1 # $2) }+ | dyn sep_by1(ty_param_bound_mod,'+') %prec IMPLTRAIT { TraitObject (toNonEmpty $2) ($1 # $2) }++-- All (non-sum) types starting with a 'for'+for_ty_no_plus :: { Ty Span }+ : for_lts unsafe extern abi fn fn_decl(arg_general) { BareFn Unsafe $4 (unspan $1) $> ($1 # $>) }+ | for_lts unsafe fn fn_decl(arg_general) { BareFn Unsafe Rust (unspan $1) $> ($1 # $>) }+ | for_lts extern abi fn fn_decl(arg_general) { BareFn Normal $3 (unspan $1) $> ($1 # $>) }+ | for_lts fn fn_decl(arg_general) { BareFn Normal Rust (unspan $1) $> ($1 # $>) }+ | for_lts trait_ref {+ let poly = PolyTraitRef (unspan $1) $2 ($1 # $2) in+ TraitObject [TraitTyParamBound poly None ($1 # $2)] ($1 # $2)+ }++-- An optional lifetime followed by an optional mutability+lifetime_mut :: { (Maybe (Lifetime Span), Mutability) }+ : lifetime mut { (Just $1, Mutable) }+ | lifetime { (Just $1, Immutable) }+ | mut { (Nothing, Mutable) }+ | {- empty -} { (Nothing, Immutable) }++-- The argument list and return type in a function+fn_decl(arg) :: { FnDecl Span }+ : '(' sep_by1(arg,',') ',' '...' ')' ret_ty { FnDecl (toList $2) $> True ($1 # $5 # $6) }+ | '(' sep_byT(arg,',') ')' ret_ty { FnDecl $2 $> False ($1 # $3 # $4) }++-- Like 'fn_decl', but also accepting a self argument+fn_decl_with_self_general :: { FnDecl Span }+ : '(' arg_self_general ',' sep_byT(arg_general,',') ')' ret_ty { FnDecl ($2 : $4) $> False ($1 # $5 # $6) }+ | '(' arg_self_general ')' ret_ty { FnDecl [$2] $> False ($1 # $3 # $4) }+ | '(' ')' ret_ty { FnDecl [] $> False ($1 # $2 # $3) }++-- Like 'fn_decl', but also accepting a self argument+fn_decl_with_self_named :: { FnDecl Span }+ : '(' arg_self_named ',' sep_by1(arg_named,',') ',' ')' ret_ty { FnDecl ($2 : toList $4) $> False ($1 # $6 # $7) }+ | '(' arg_self_named ',' sep_by1(arg_named,',') ')' ret_ty { FnDecl ($2 : toList $4) $> False ($1 # $5 # $6) }+ | '(' arg_self_named ',' ')' ret_ty { FnDecl [$2] $> False ($1 # $3 # $4) }+ | '(' arg_self_named ')' ret_ty { FnDecl [$2] $> False ($1 # $3 # $4) }+ | fn_decl(arg_named) { $1 }+++-- parse_ty_param_bounds(BoundParsingMode::Bare) == sep_by1(ty_param_bound,'+')+ty_param_bound :: { TyParamBound Span }+ : lifetime { RegionTyParamBound $1 (spanOf $1) }+ | poly_trait_ref { TraitTyParamBound $1 None (spanOf $1) }+ | '(' poly_trait_ref ')' { TraitTyParamBound $2 None ($1 # $3) }++poly_trait_ref_mod_bound :: { TyParamBound Span }+ : poly_trait_ref { TraitTyParamBound $1 None (spanOf $1) }+ | '?' poly_trait_ref { TraitTyParamBound $2 Maybe ($1 # $2) }++-- parse_ty_param_bounds(BoundParsingMode::Modified) == sep_by1(ty_param_bound_mod,'+')+ty_param_bound_mod :: { TyParamBound Span }+ : ty_param_bound { $1 }+ | '?' poly_trait_ref { TraitTyParamBound $2 Maybe ($1 # $2) }++-- Sort of like parse_opt_abi() -- currently doesn't handle raw string ABI+abi :: { Abi }+ : str {% case unspan $1 of+ LiteralTok (StrTok "cdecl") Nothing -> pure Cdecl + LiteralTok (StrTok "stdcall") Nothing -> pure Stdcall + LiteralTok (StrTok "fastcall") Nothing -> pure Fastcall + LiteralTok (StrTok "vectorcall") Nothing -> pure Vectorcall + LiteralTok (StrTok "aapcs") Nothing -> pure Aapcs + LiteralTok (StrTok "win64") Nothing -> pure Win64 + LiteralTok (StrTok "sysv64") Nothing -> pure SysV64 + LiteralTok (StrTok "ptx-kernel") Nothing -> pure PtxKernel + LiteralTok (StrTok "msp430-interrupt") Nothing -> pure Msp430Interrupt + LiteralTok (StrTok "x86-interrupt") Nothing -> pure X86Interrupt + LiteralTok (StrTok "Rust") Nothing -> pure Rust + LiteralTok (StrTok "C") Nothing -> pure C + LiteralTok (StrTok "system") Nothing -> pure System + LiteralTok (StrTok "rust-intrinsic") Nothing -> pure RustIntrinsic + LiteralTok (StrTok "rust-call") Nothing -> pure RustCall + LiteralTok (StrTok "platform-intrinsic") Nothing -> pure PlatformIntrinsic+ LiteralTok (StrTok "unadjusted") Nothing -> pure Unadjusted + _ -> parseError $1 {- "invalid ABI" -}+ }+ | {- empty -} { C }++-- parse_ret_ty+ret_ty :: { Maybe (Ty Span) }+ : '->' ty_no_plus { Just $2 }+ | {- empty -} { Nothing }++-- parse_poly_trait_ref()+poly_trait_ref :: { PolyTraitRef Span }+ : trait_ref { PolyTraitRef [] $1 (spanOf $1) }+ | for_lts trait_ref { PolyTraitRef (unspan $1) $2 ($1 # $2) }++-- parse_for_lts()+-- Unlike the Rust libsyntax version, this _requires_ the 'for'+for_lts :: { Spanned [LifetimeDef Span] }+ : for '<' sep_byT(lifetime_def,',') '>' { Spanned $3 ($1 # $>) }++-- Definition of a lifetime: attributes can come before the lifetime, and a list of bounding+-- lifetimes can come after the lifetime.+lifetime_def :: { LifetimeDef Span }+ : many(outer_attribute) lifetime ':' sep_by1T(lifetime,'+') { LifetimeDef $1 $2 (toList $4) ($1 # $2 # $>) }+ | many(outer_attribute) lifetime { LifetimeDef $1 $2 [] ($1 # $2 # $>) }+++---------------+-- Arguments --+---------------++-- Argument (requires a name / pattern, ie. @parse_arg_general(true)@)+arg_named :: { Arg Span }+ : ntArg { $1 }+ | pat ':' ty { Arg (Just $1) $3 ($1 # $3) }++-- Argument (does not require a name / pattern, ie. @parse_arg_general(false)@)+--+-- Remark: not all patterns are accepted (as per <https://github.com/rust-lang/rust/issues/35203>)+-- The details for which patterns _should_ be accepted fall into @is_named_argument()@.+arg_general :: { Arg Span }+ : ntArg { $1 }+ | ty { Arg Nothing $1 (spanOf $1) }+ | '_' ':' ty { Arg (Just (WildP (spanOf $1))) $3 ($1 # $3) }+ | ident ':' ty { Arg (Just (IdentP (ByValue Immutable) (unspan $1) Nothing (spanOf $1))) $3 ($1 # $3) }+ | mut ident ':' ty { Arg (Just (IdentP (ByValue Mutable) (unspan $2) Nothing (spanOf $2))) $4 ($1 # $4) }+ | '&' '_' ':' ty { Arg (Just (RefP (WildP (spanOf $2)) Immutable ($1 # $2))) $4 ($1 # $4) }+ | '&' ident ':' ty { Arg (Just (RefP (IdentP (ByValue Immutable) (unspan $2) Nothing (spanOf $2)) Immutable ($1 # $2))) $4 ($1 # $4) }+ | '&&' '_' ':' ty { Arg (Just (RefP (RefP (WildP (spanOf $2)) Immutable (nudge 1 0 ($1 # $2))) Immutable ($1 # $2))) $4 ($1 # $4) }+ | '&&' ident ':' ty { Arg (Just (RefP (RefP (IdentP (ByValue Immutable) (unspan $2) Nothing (spanOf $2)) Immutable (nudge 1 0 ($1 # $2))) Immutable ($1 # $2))) $4 ($1 # $4) }+ +-- Self argument (only allowed in trait function signatures)+arg_self_general :: { Arg Span }+ : mut self { SelfValue Mutable ($1 # $>) }+ | self ':' ty { SelfExplicit $3 Immutable ($1 # $>) }+ | mut self ':' ty { SelfExplicit $4 Mutable ($1 # $>) }+ | arg_general {+ case $1 of+ Arg Nothing (PathTy Nothing (Path False [PathSegment "self" Nothing _] _) _) x -> SelfValue Immutable x+ Arg Nothing (Rptr l m (PathTy Nothing (Path False [PathSegment "self" Nothing _] _) _) _) x -> SelfRegion l m x+ _ -> $1+ }++-- Self argument (only allowed in impl function signatures)+arg_self_named :: { Arg Span }+ : self { SelfValue Immutable ($1 # $>) }+ | mut self { SelfValue Mutable ($1 # $>) }+ | '&' self { SelfRegion Nothing Immutable ($1 # $>) }+ | '&' lifetime self { SelfRegion (Just $2) Immutable ($1 # $>) }+ | '&' mut self { SelfRegion Nothing Mutable ($1 # $>) }+ | '&' lifetime mut self { SelfRegion (Just $2) Mutable ($1 # $>) }+ | self ':' ty { SelfExplicit $3 Immutable ($1 # $>) }+ | mut self ':' ty { SelfExplicit $4 Mutable ($1 # $>) }++-- Lambda expression argument+lambda_arg :: { Arg Span }+ : ntArg { $1 }+ | pat ':' ty { Arg (Just $1) $3 ($1 # $3) }+ | pat { Arg (Just $1) (Infer mempty) (spanOf $1) }+++--------------+-- Patterns --+--------------++-- There is a funky trick going on here around 'IdentP'. When there is a binding mode (ie a 'mut' or+-- 'ref') or an '@' pattern, everything is fine, but otherwise there is no difference between an+-- expression variable path and a pattern. To deal with this, we intercept expression paths with+-- only one segment, no path parameters, and not global and turn them into identifier patterns.+pat :: { Pat Span }+ : ntPat { $1 }+ | '_' { WildP (spanOf $1) }+ | '&' mut pat { RefP $3 Mutable ($1 # $3) }+ | '&' pat { RefP $2 Immutable ($1 # $2) }+ | '&&' mut pat { RefP (RefP $3 Mutable (nudge 1 0 ($1 # $3))) Immutable ($1 # $3) }+ | '&&' pat { RefP (RefP $2 Immutable (nudge 1 0 ($1 # $2))) Immutable ($1 # $2) }+ | lit_expr { LitP $1 (spanOf $1) }+ | '-' lit_expr { LitP (Unary [] Neg $2 ($1 # $2)) ($1 # $2) }+ | box pat { BoxP $2 ($1 # $2) }+ | binding_mode1 binding_mode1_ident '@' pat { IdentP (unspan $1) (unspan $2) (Just $4) ($1 # $>) }+ | binding_mode1 binding_mode1_ident { IdentP (unspan $1) (unspan $2) Nothing ($1 # $>) }+ | ident '@' pat { IdentP (ByValue Immutable) (unspan $1) (Just $3) ($1 # $>) }+ | expr_path {+ case $1 of+ Path False [PathSegment i Nothing _] _ -> IdentP (ByValue Immutable) i Nothing (spanOf $1)+ _ -> PathP Nothing $1 (spanOf $1)+ }+ | expr_qual_path { PathP (Just (fst (unspan $1))) (snd (unspan $1)) ($1 # $>) }+ | lit_or_path '...' lit_or_path { RangeP $1 $3 ($1 # $>) }+ | lit_or_path '..=' lit_or_path { RangeP $1 $3 ($1 # $>) }+ | expr_path '{' '..' '}' { StructP $1 [] True ($1 # $>) }+ | expr_path '{' pat_fields '}' { let (fs,b) = $3 in StructP $1 fs b ($1 # $>) }+ | expr_path '(' pat_tup ')' { let (ps,m,_) = $3 in TupleStructP $1 ps m ($1 # $>) }+ | expr_mac { MacP $1 (spanOf $1) }+ | '[' pat_slice ']' { let (b,s,a) = $2 in SliceP b s a ($1 # $3) }+ | '(' pat_tup ')' {%+ case $2 of+ ([p], Nothing, False) -> parseError (CloseDelim Paren)+ (ps,m,t) -> pure (TupleP ps m ($1 # $3))+ }+++-- The first element is the spans, the second the position of '..', and the third if there is a+-- trailing comma+pat_tup :: { ([Pat Span], Maybe Int, Bool) }+ : sep_by1(pat,',') ',' '..' ',' sep_by1(pat,',') { (toList ($1 <> $5), Just (length $1), False) }+ | sep_by1(pat,',') ',' '..' ',' sep_by1(pat,',') ',' { (toList ($1 <> $5), Just (length $1), True) }+ | sep_by1(pat,',') ',' '..' { (toList $1, Just (length $1), False) }+ | sep_by1(pat,',') { (toList $1, Nothing, False) }+ | sep_by1(pat,',') ',' { (toList $1, Nothing, True) }+ | '..' ',' sep_by1(pat,',') { (toList $3, Just 0, False) }+ | '..' ',' sep_by1(pat,',') ',' { (toList $3, Just 0, True) }+ | '..' { ([], Just 0, False) }+ | {- empty -} { ([], Nothing, False) }++-- The first element is the patterns at the beginning of the slice, the second the optional binding+-- for the middle slice ('Nothing' if there is no '..' and 'Just (WildP mempty) is there is one, but+-- unlabelled), and the third is the patterns at the end of the slice.+pat_slice :: { ([Pat Span], Maybe (Pat Span), [Pat Span]) }+ : sep_by1(pat,',') ',' '..' ',' sep_by1T(pat,',') { (toList $1, Just (WildP mempty), toList $5) }+ | sep_by1(pat,',') ',' '..' { (toList $1, Just (WildP mempty), []) }+ | sep_by1(pat,',') '..' ',' sep_by1T(pat,',') { let (xs, x) = unsnoc $1 in (toList xs, Just x, toList $4) }+ | sep_by1(pat,',') '..' { let (xs, x) = unsnoc $1 in (toList xs, Just x, []) }+ | sep_by1T(pat,',') { (toList $1, Nothing, []) }+ | '..' ',' sep_by1T(pat,',') { ([], Just (WildP mempty), toList $3) }+ | '..' { ([], Just (WildP mempty), []) }+ | {- empty -} { ([], Nothing, []) }+++-- Endpoints of range patterns+lit_or_path :: { Expr Span }+ : expr_path { PathExpr [] Nothing $1 (spanOf $1) }+ | expr_qual_path { PathExpr [] (Just (fst (unspan $1))) (snd (unspan $1)) (spanOf $1) }+ | '-' lit_expr { Unary [] Neg $2 ($1 # $2) }+ | lit_expr { $1 }++-- Used in patterns for tuple and expression patterns+pat_fields :: { ([FieldPat Span], Bool) }+ : sep_byT(pat_field,',') { ($1, False) }+ | sep_by1(pat_field,',') ',' '..' { (toList $1, True) }++pat_field :: { FieldPat Span }+ : binding_mode ident+ { FieldPat Nothing (IdentP (unspan $1) (unspan $2) Nothing (spanOf $2)) ($1 # $2) }+ | box binding_mode ident+ { FieldPat Nothing (BoxP (IdentP (unspan $2) (unspan $3) Nothing ($2 # $3)) ($1 # $3)) ($1 # $3) }+ | binding_mode ident ':' pat+ { FieldPat (Just (unspan $2)) $4 ($1 # $2 # $4) }+++-- Used prefixing IdentP patterns (not empty - that is a seperate pattern case)+binding_mode1 :: { Spanned BindingMode }+ : ref mut { Spanned (ByRef Mutable) ($1 # $2) }+ | ref { Spanned (ByRef Immutable) (spanOf $1) }+ | mut { Spanned (ByValue Mutable) (spanOf $1) }++-- Used for patterns for fields (includes the empty case)+binding_mode :: { Spanned BindingMode }+ : binding_mode1 { $1 }+ | {- empty -} { Spanned (ByValue Immutable) mempty }+++-----------------+-- Expressions --+-----------------++-- Expressions are a pain to parse. The Rust language places "restrictions" preventing certain+-- specific expressions from being valid in a certain context. Elsewhere in the parser, it will turn+-- on or off these restrictions. Unfortunately, that doesn't work well at all in a grammar, so we+-- have to define production rules for every combination of restrications used. Parametrized+-- productions make this a bit easier by letting us factor out the core expressions used everywhere.++-- Generalized expressions, parametrized by+--+-- * 'lhs' - expressions allowed on the left extremity of the term+-- * 'rhs' - expressions allowed on the right extremity of the term+-- * 'rhs2' - expressions allowed on the right extremity following '..'/'.../..='+--+-- Precedences are handled by Happy (right at the end of the token section)+gen_expression(lhs,rhs,rhs2) :: { Expr Span }+ -- immediate expressions+ : ntExpr { $1 }+ | lit_expr { $1 }+ | '[' sep_byT(expr,',') ']' { Vec [] $2 ($1 # $>) }+ | '[' inner_attrs sep_byT(expr,',') ']' { Vec (toList $2) $3 ($1 # $>) }+ | '[' expr ';' expr ']' { Repeat [] $2 $4 ($1 # $>) }+ | expr_mac { MacExpr [] $1 (spanOf $1) }+ | expr_path %prec PATH { PathExpr [] Nothing $1 (spanOf $1) }+ | expr_qual_path { PathExpr [] (Just (fst (unspan $1))) (snd (unspan $1)) (spanOf $1) }+ -- unary expressions+ | '*' rhs %prec UNARY { Unary [] Deref $2 ($1 # $>) }+ | '!' rhs %prec UNARY { Unary [] Not $2 ($1 # $>) }+ | '-' rhs %prec UNARY { Unary [] Neg $2 ($1 # $>) }+ | '&' rhs %prec UNARY { AddrOf [] Immutable $2 ($1 # $>) }+ | '&' mut rhs %prec UNARY { AddrOf [] Mutable $3 ($1 # $>) }+ | '&&' rhs %prec UNARY { AddrOf [] Immutable (AddrOf [] Immutable $2 (nudge 1 0 ($1 # $2))) ($1 # $2) }+ | '&&' mut rhs %prec UNARY { AddrOf [] Immutable (AddrOf [] Mutable $3 (nudge 1 0 ($1 # $3))) ($1 # $3) }+ | box rhs %prec UNARY { Box [] $2 ($1 # $>) }+ -- left-recursive+ | left_gen_expression(lhs,rhs,rhs2) { $1 }+ -- range expressions+ | '..' rhs2 %prec PREFIXRNG { Range [] Nothing (Just $2) HalfOpen ($1 # $2) }+ | '...' rhs2 %prec PREFIXRNG { Range [] Nothing (Just $2) Closed ($1 # $2) }+ | '..=' rhs2 %prec PREFIXRNG { Range [] Nothing (Just $2) Closed ($1 # $2) }+ | '..' %prec SINGLERNG { Range [] Nothing Nothing HalfOpen (spanOf $1) }+ | '..=' %prec SINGLERNG { Range [] Nothing Nothing Closed (spanOf $1) }+ -- low precedence prefix expressions+ | return { Ret [] Nothing (spanOf $1) }+ | return rhs { Ret [] (Just $2) ($1 # $2) }+ | yield { Yield [] Nothing (spanOf $1) }+ | yield rhs { Yield [] (Just $2) ($1 # $2) }+ | continue { Continue [] Nothing (spanOf $1) }+ | continue label { Continue [] (Just $2) ($1 # $2) }+ | break { Break [] Nothing Nothing (spanOf $1) }+ | break rhs { Break [] Nothing (Just $2) ($1 # $2) }+ | break label { Break [] (Just $2) Nothing ($1 # $2) }+ | break label rhs %prec break { Break [] (Just $2) (Just $3) ($1 # $3) }+ -- lambda expressions+ | static move lambda_args rhs %prec LAMBDA+ { Closure [] Immovable Value (FnDecl (unspan $3) Nothing False (spanOf $3)) $> ($1 # $>) }+ | move lambda_args rhs %prec LAMBDA+ { Closure [] Movable Value (FnDecl (unspan $2) Nothing False (spanOf $2)) $> ($1 # $>) }+ | static lambda_args rhs %prec LAMBDA+ { Closure [] Immovable Ref (FnDecl (unspan $2) Nothing False (spanOf $2)) $> ($1 # $>) }+ | lambda_args rhs %prec LAMBDA+ { Closure [] Movable Ref (FnDecl (unspan $1) Nothing False (spanOf $1)) $> ($1 # $>) }++-- Variant of 'gen_expression' which only constructs expressions starting with another expression.+left_gen_expression(lhs,rhs,rhs2) :: { Expr Span }+ : postfix_blockexpr(lhs) { $1 }+ | lhs '[' expr ']' { Index [] $1 $3 ($1 # $>) }+ | lhs '(' sep_byT(expr,',') ')' { Call [] $1 $3 ($1 # $>) }+ -- unary expressions+ | lhs ':' ty_no_plus { TypeAscription [] $1 $3 ($1 # $>) }+ | lhs as ty_no_plus { Cast [] $1 $3 ($1 # $>) }+ -- binary expressions+ | lhs '*' rhs { Binary [] MulOp $1 $3 ($1 # $>) }+ | lhs '/' rhs { Binary [] DivOp $1 $3 ($1 # $>) }+ | lhs '%' rhs { Binary [] RemOp $1 $3 ($1 # $>) }+ | lhs '+' rhs { Binary [] AddOp $1 $3 ($1 # $>) }+ | lhs '-' rhs { Binary [] SubOp $1 $3 ($1 # $>) }+ | lhs '<<' rhs { Binary [] ShlOp $1 $3 ($1 # $>) }+ | lhs '>>' rhs { Binary [] ShrOp $1 $3 ($1 # $>) }+ | lhs '&' rhs { Binary [] BitAndOp $1 $3 ($1 # $>) }+ | lhs '^' rhs { Binary [] BitXorOp $1 $3 ($1 # $>) }+ | lhs '|' rhs { Binary [] BitOrOp $1 $3 ($1 # $>) }+ | lhs '==' rhs { Binary [] EqOp $1 $3 ($1 # $>) }+ | lhs '!=' rhs { Binary [] NeOp $1 $3 ($1 # $>) }+ | lhs '<' rhs { Binary [] LtOp $1 $3 ($1 # $>) }+ | lhs '>' rhs { Binary [] GtOp $1 $3 ($1 # $>) }+ | lhs '<=' rhs { Binary [] LeOp $1 $3 ($1 # $>) }+ | lhs '>=' rhs { Binary [] GeOp $1 $3 ($1 # $>) }+ | lhs '&&' rhs { Binary [] AndOp $1 $3 ($1 # $>) }+ | lhs '||' rhs { Binary [] OrOp $1 $3 ($1 # $>) }+ -- range expressions+ | lhs '..' %prec POSTFIXRNG { Range [] (Just $1) Nothing HalfOpen ($1 # $>) }+ | lhs '...' %prec POSTFIXRNG { Range [] (Just $1) Nothing Closed ($1 # $>) }+ | lhs '..=' %prec POSTFIXRNG { Range [] (Just $1) Nothing Closed ($1 # $>) }+ | lhs '..' rhs2 %prec INFIXRNG { Range [] (Just $1) (Just $3) HalfOpen ($1 # $>) }+ | lhs '...' rhs2 %prec INFIXRNG { Range [] (Just $1) (Just $3) Closed ($1 # $>) }+ | lhs '..=' rhs2 %prec INFIXRNG { Range [] (Just $1) (Just $3) Closed ($1 # $>) }+ -- assignment expressions+ | lhs '<-' rhs { InPlace [] $1 $3 ($1 # $>) }+ | lhs '=' rhs { Assign [] $1 $3 ($1 # $>) }+ | lhs '>>=' rhs { AssignOp [] ShrOp $1 $3 ($1 # $>) }+ | lhs '<<=' rhs { AssignOp [] ShlOp $1 $3 ($1 # $>) }+ | lhs '-=' rhs { AssignOp [] SubOp $1 $3 ($1 # $>) }+ | lhs '+=' rhs { AssignOp [] AddOp $1 $3 ($1 # $>) }+ | lhs '*=' rhs { AssignOp [] MulOp $1 $3 ($1 # $>) }+ | lhs '/=' rhs { AssignOp [] DivOp $1 $3 ($1 # $>) }+ | lhs '^=' rhs { AssignOp [] BitXorOp $1 $3 ($1 # $>) }+ | lhs '|=' rhs { AssignOp [] BitOrOp $1 $3 ($1 # $>) }+ | lhs '&=' rhs { AssignOp [] BitAndOp $1 $3 ($1 # $>) }+ | lhs '%=' rhs { AssignOp [] RemOp $1 $3 ($1 # $>) }++-- Postfix expressions that can come after an expression block, in a 'stmt'+--+-- * `{ 1 }[0]` isn't here because it is treated as `{ 1 }; [0]`+-- * `{ 1 }(0)` isn't here because it is treated as `{ 1 }; (0)`+--+postfix_blockexpr(lhs) :: { Expr Span }+ : lhs '?' { Try [] $1 ($1 # $>) }+ | lhs '.' ident %prec FIELD { FieldAccess [] $1 (unspan $3) ($1 # $>) }+ | lhs '.' ident '(' sep_byT(expr,',') ')'+ { MethodCall [] $1 (unspan $3) Nothing $5 ($1 # $>) }+ | lhs '.' ident '::' '<' sep_byT(ty,',') '>' '(' sep_byT(expr,',') ')'+ { MethodCall [] $1 (unspan $3) (Just $6) $9 ($1 # $>) }+ | lhs '.' int {%+ case lit $3 of+ Int Dec i _ Unsuffixed _ -> pure (TupField [] $1 (fromIntegral i) ($1 # $3))+ _ -> parseError $3+ }++-- Postfix expressions that can come after an expression block, in a 'stmt'+--+-- * `{ 1 }[0]` isn't here because it is treated as `{ 1 }; [0]`+-- * `{ 1 }(0)` isn't here because it is treated as `{ 1 }; (0)`+--+postfix_blockexpr(lhs) :: { Expr Span }+ : lhs '?' { Try [] $1 ($1 # $>) }+ | lhs '.' ident %prec FIELD { FieldAccess [] $1 (unspan $3) ($1 # $>) }+ | lhs '.' ident '(' sep_byT(expr,',') ')'+ { MethodCall [] $1 (unspan $3) Nothing $5 ($1 # $>) }+ | lhs '.' ident '::' '<' sep_byT(ty,',') '>' '(' sep_byT(expr,',') ')'+ { MethodCall [] $1 (unspan $3) (Just $6) $9 ($1 # $>) }+ | lhs '.' int {%+ case lit $3 of+ Int Dec i _ Unsuffixed _ -> pure (TupField [] $1 (fromIntegral i) ($1 # $3))+ _ -> parseError $3+ }++-- Postfix expressions that can come after an expression block, in a 'stmt'+--+-- * `{ 1 }[0]` isn't here because it is treated as `{ 1 }; [0]`+-- * `{ 1 }(0)` isn't here because it is treated as `{ 1 }; (0)`+--+postfix_blockexpr(lhs) :: { Expr Span }+ : lhs '?' { Try [] $1 ($1 # $>) }+ | lhs '.' ident %prec FIELD { FieldAccess [] $1 (unspan $3) ($1 # $>) }+ | lhs '.' ident '(' sep_byT(expr,',') ')'+ { MethodCall [] $1 (unspan $3) Nothing $5 ($1 # $>) }+ | lhs '.' ident '::' '<' sep_byT(ty,',') '>' '(' sep_byT(expr,',') ')'+ { MethodCall [] $1 (unspan $3) (Just $6) $9 ($1 # $>) }+ | lhs '.' int {%+ case lit $3 of+ Int Dec i _ Unsuffixed _ -> pure (TupField [] $1 (fromIntegral i) ($1 # $3))+ _ -> parseError $3+ }++++-- Then, we instantiate this general production into the following families of rules:+--+-- ['expr'] Most general class of expressions, no restrictions+--+-- ['nostruct_expr'] Forbids struct literals (for use as scrutinee of loops, ifs, etc)+--+-- ['nostructblock_expr'] Forbids struct literals and block expressions (but not block-like things+-- like 'if' expressions or 'loop' expressions)+--+-- ['nonblock_expr'] Forbids expressions starting with blocks (things such as '{ 1 } + 2' are+-- not allowed, while struct expressions are - their "block" is at the end+-- of the expression)+--+-- ['blockpostfix_expr'] Allows expressions starting with blocks (things such as '{ 1 }? + 1')+-- but only when the leading block is itself a postfix expression.+--+-- There is also a later instantiation revolving around 'match' expressions, but it has some+-- different types.++expr :: { Expr Span }+ : gen_expression(expr,expr,expr) { $1 }+ | paren_expr { $1 }+ | struct_expr { $1 }+ | block_expr { $1 }+ | lambda_expr_block { $1 }+ | embedded_expr { $1 }++nostruct_expr :: { Expr Span }+ : gen_expression(nostruct_expr,nostruct_expr,nonstructblock_expr) { $1 }+ | paren_expr { $1 }+ | block_expr { $1 }++nonstructblock_expr :: { Expr Span }+ : gen_expression(nonstructblock_expr,nostruct_expr,nonstructblock_expr) { $1 }+ | paren_expr { $1 }+ | block_like_expr { $1 }+ | unsafe inner_attrs_block+ { let (as, Block ss r x) = $> in BlockExpr as (Block ss Unsafe ($1 # x)) ($1 # x) }++nonblock_expr :: { Expr Span }+ : gen_expression(nonblock_expr,expr,expr) { $1 }+ | paren_expr { $1 }+ | struct_expr { $1 }+ | lambda_expr_block { $1 }++blockpostfix_expr :: { Expr Span }+ : postfix_blockexpr(block_like_expr) { $1 }+ | postfix_blockexpr(vis_safety_block) { $1 }+ | left_gen_expression(blockpostfix_expr,expr,expr) { $1 } ++-- Can't put attributes on embedded code (seems like a reasonable restriction at the time of this writing):+embedded_expr :: { Expr Span }+ : EMBEDDED_EXPR { toEmbedded [] $1 }++-- Finally, what remains is the more mundane definitions of particular types of expressions.++-- labels on loops+label :: { Label Span }+ : LIFETIME { let Spanned (LifetimeTok (Ident (Name l) _ _)) s = $1 in Label l s }++-- Literal expressions (composed of just literals)+lit_expr :: { Expr Span }+ : lit { Lit [] $1 (spanOf $1) }++-- An expression ending in a '{ ... }' block. Useful since "There is a convenience rule that allows+-- one to omit the separating ';' after 'if', 'match', 'loop', 'for', 'while'"+block_expr :: { Expr Span }+ : block_like_expr { $1 }+ | inner_attrs_block { let (as,b) = $1 in BlockExpr as b (spanOf b) }+ | unsafe inner_attrs_block+ { let (as, Block ss r x) = $> in BlockExpr as (Block ss Unsafe ($1 # x)) ($1 # x) }++-- Any expression ending in a '{ ... }' block except a block itself.+block_like_expr :: { Expr Span }+ : if_expr { $1 }+ | loop inner_attrs_block { let (as,b) = $> in Loop as b Nothing ($1 # b) }+ | label ':' loop inner_attrs_block { let (as,b) = $> in Loop as b (Just $1) ($1 # b) }+ | for pat in nostruct_expr inner_attrs_block { let (as,b) = $> in ForLoop as $2 $4 b Nothing ($1 # b) }+ | label ':' for pat in nostruct_expr inner_attrs_block { let (as,b) = $> in ForLoop as $4 $6 b (Just $1) ($1 # b) }+ | while nostruct_expr inner_attrs_block { let (as,b) = $> in While as $2 b Nothing ($1 # b) }+ | label ':' while nostruct_expr inner_attrs_block { let (as,b) = $> in While as $4 b (Just $1) ($1 # b) }+ | while let pats '=' nostruct_expr inner_attrs_block { let (as,b) = $> in WhileLet as $3 $5 b Nothing ($1 # b) }+ | label ':' while let pats '=' nostruct_expr inner_attrs_block { let (as,b) = $> in WhileLet as $5 $7 b (Just $1) ($1 # b) }+ | match nostruct_expr '{' '}' { Match [] $2 [] ($1 # $>) }+ | match nostruct_expr '{' inner_attrs '}' { Match (toList $4) $2 [] ($1 # $>) }+ | match nostruct_expr '{' arms '}' { Match [] $2 $4 ($1 # $>) }+ | match nostruct_expr '{' inner_attrs arms '}' { Match (toList $4) $2 $5 ($1 # $>) }+ | expr_path '!' '{' token_stream '}' { MacExpr [] (Mac $1 $4 ($1 # $>)) ($1 # $>) }+ | do catch inner_attrs_block { let (as,b) = $> in Catch as b ($1 # b) }++-- 'if' expressions are a bit special since they can have an arbitrary number of 'else if' chains.+if_expr :: { Expr Span }+ : if nostruct_expr block else_expr { If [] $2 $3 $4 ($1 # $3 # $>) }+ | if let pats '=' nostruct_expr block else_expr { IfLet [] $3 $5 $6 $7 ($1 # $6 # $>) }++else_expr :: { Maybe (Expr Span) }+ : else block { Just (BlockExpr [] $2 (spanOf $2)) }+ | else if_expr { Just $2 }+ | {- empty -} { Nothing }++-- Match arms usually have to be seperated by commas (with an optional comma at the end). This+-- condition is loosened (so that there is no seperator needed) if the arm ends in a safe block.+arms :: { [Arm Span] }+ : ntArm { [$1] }+ | ntArm arms { $1 : $2 }+ | many(outer_attribute) pats arm_guard '=>' expr_arms { let (e,as) = $> in (Arm $1 $2 $3 e ($1 # $2 # e) : as) }++pats :: { NonEmpty (Pat Span) }+ : '|' sep_by1(pat,'|') { toNonEmpty $2 }+ | sep_by1(pat,'|') { toNonEmpty $1 }++arm_guard :: { Maybe (Expr Span) }+ : {- empty -} { Nothing }+ | if expr { Just $2 }++-- Possibly more match arms, with a comma if present+comma_arms :: { [Arm Span] }+ : {- empty -} { [] }+ | ',' { [] }+ | ',' arms { $2 }++-- An expression followed by match arms. If there is a comma needed, it is added+expr_arms :: { (Expr Span, [Arm Span]) }+ : nonblock_expr comma_arms { ($1, $2) }+ | blockpostfix_expr comma_arms { ($1, $2) }+ | vis_safety_block comma_arms { ($1, $2) }+ | vis_safety_block arms { ($1, $2) }+ | block_like_expr comma_arms { ($1, $2) }+ | block_like_expr arms { ($1, $2) }++-- As per https://github.com/rust-lang/rust/issues/15701 (as of March 10 2017), the only way to have+-- attributes on expressions should be with inner attributes on a paren expression.+paren_expr :: { Expr Span }+ : '(' ')' { TupExpr [] [] ($1 # $>) }+ | '(' inner_attrs ')' { TupExpr (toList $2) [] ($1 # $>) }+ | '(' expr ')' { ParenExpr [] $2 ($1 # $>) }+ | '(' inner_attrs expr ')' { ParenExpr (toList $2) $3 ($1 # $>) }+ | '(' expr ',' ')' { TupExpr [] [$2] ($1 # $>) }+ | '(' inner_attrs expr ',' ')' { TupExpr (toList $2) [$3] ($1 # $>) }+ | '(' expr ',' sep_by1T(expr,',') ')' { TupExpr [] ($2 : toList $4) ($1 # $>) }+ | '(' inner_attrs expr ',' sep_by1T(expr,',') ')' { TupExpr (toList $2) ($3 : toList $5) ($1 # $>) }+++-- Closure ending in blocks+lambda_expr_block :: { Expr Span }+ : static move lambda_args '->' ty_no_plus block+ { Closure [] Immovable Value (FnDecl (unspan $3) (Just $5) False (spanOf $3)) (BlockExpr [] $> (spanOf $>)) ($1 # $>) }+ | move lambda_args '->' ty_no_plus block+ { Closure [] Movable Value (FnDecl (unspan $2) (Just $4) False (spanOf $2)) (BlockExpr [] $> (spanOf $>)) ($1 # $>) }+ | static lambda_args '->' ty_no_plus block+ { Closure [] Immovable Ref (FnDecl (unspan $2) (Just $4) False (spanOf $2)) (BlockExpr [] $> (spanOf $>)) ($1 # $>) }+ | lambda_args '->' ty_no_plus block+ { Closure [] Movable Ref (FnDecl (unspan $1) (Just $3) False (spanOf $1)) (BlockExpr [] $> (spanOf $>)) ($1 # $>) }++-- Lambda expression arguments block+lambda_args :: { Spanned [Arg Span] }+ : '||' { Spanned [] (spanOf $1) }+ | '|' sep_byT(lambda_arg,',') pipe '|' { Spanned $2 ($1 # $4) }+++-- Struct expression literal+struct_expr :: { Expr Span }+ : expr_path '{' '..' expr '}' { Struct [] $1 [] (Just $4) ($1 # $>) }+ | expr_path '{' inner_attrs '..' expr '}' { Struct (toList $3) $1 [] (Just $5) ($1 # $>) }+ | expr_path '{' sep_by1(field,',') ',' '..' expr '}' { Struct [] $1 (toList $3) (Just $6) ($1 # $>) }+ | expr_path '{' inner_attrs sep_by1(field,',') ',' '..' expr '}' { Struct (toList $3) $1 (toList $4) (Just $7) ($1 # $>) }+ | expr_path '{' sep_byT(field,',') '}' { Struct [] $1 $3 Nothing ($1 # $>) }+ | expr_path '{' inner_attrs sep_byT(field,',') '}' { Struct (toList $3) $1 $4 Nothing ($1 # $>) }++field :: { Field Span }+ : ident ':' expr { Field (unspan $1) (Just $3) ($1 # $3) }+ | ident { Field (unspan $1) Nothing (spanOf $1) }++-- an expression block that won't cause conflicts with stmts+vis_safety_block :: { Expr Span }+ : pub_or_inherited safety inner_attrs_block {%+ let (as, Block ss r x) = $3+ e = BlockExpr as (Block ss (unspan $2) ($2 # x)) ($2 # x)+ in noVis $1 e+ }++-- an expression starting with 'union' or 'default' (as identifiers) that won't cause conflicts with stmts+vis_union_def_nonblock_expr :: { Expr Span }+ : union_default_expr { $1 }+ | left_gen_expression(vis_union_def_nonblock_expr, expr, expr) { $1 }++union_default_expr :: { Expr Span }+ : pub_or_inherited union {%+ noVis $1 (PathExpr [] Nothing (Path False [PathSegment "union" Nothing (spanOf $2)] (spanOf $1)) (spanOf $1))+ }+ | pub_or_inherited default {%+ noVis $1 (PathExpr [] Nothing (Path False [PathSegment "default" Nothing (spanOf $2)] (spanOf $1)) (spanOf $1))+ }+++----------------+-- Statements --+----------------++stmts :: { [Stmt Span] }+ : many(stmt) { $1 }++stmt :: { Stmt Span }+ : ntStmt { $1 }+ | many(outer_attribute) let pat ':' ty initializer ';' { Local $3 (Just $5) $6 $1 ($1 # $2 # $>) }+ | many(outer_attribute) let pat initializer ';' { Local $3 Nothing $4 $1 ($1 # $2 # $>) }+ | many(outer_attribute) nonblock_expr ';' { toStmt ($1 `addAttrs` $2) True False ($1 # $2 # $3) }+ | many(outer_attribute) block_like_expr ';' { toStmt ($1 `addAttrs` $2) True True ($1 # $2 # $3) }+ | many(outer_attribute) blockpostfix_expr ';' { toStmt ($1 `addAttrs` $2) True True ($1 # $2 # $3) }+ | many(outer_attribute) vis_union_def_nonblock_expr ';' { toStmt ($1 `addAttrs` $2) True False ($1 # $2 # $3) } + | many(outer_attribute) block_like_expr %prec NOSEMI { toStmt ($1 `addAttrs` $2) False True ($1 # $2) }+ | many(outer_attribute) vis_safety_block ';' { toStmt ($1 `addAttrs` $2) True True ($1 # $2 # $>) }+ | many(outer_attribute) vis_safety_block %prec NOSEMI { toStmt ($1 `addAttrs` $2) False True ($1 # $2) }+ | gen_item(pub_or_inherited) { ItemStmt $1 (spanOf $1) }+ | many(outer_attribute) expr_path '!' ident '[' token_stream ']' ';'+ { ItemStmt (macroItem $1 (Just (unspan $4)) (Mac $2 $6 ($2 # $>)) ($1 # $2 # $>)) ($1 # $2 # $>) }+ | many(outer_attribute) expr_path '!' ident '(' token_stream ')' ';'+ { ItemStmt (macroItem $1 (Just (unspan $4)) (Mac $2 $6 ($2 # $>)) ($1 # $2 # $>)) ($1 # $2 # $>) }+ | many(outer_attribute) expr_path '!' ident '{' token_stream '}'+ { ItemStmt (macroItem $1 (Just (unspan $4)) (Mac $2 $6 ($2 # $>)) ($1 # $2 # $>)) ($1 # $2 # $>) }++pub_or_inherited :: { Spanned (Visibility Span) }+ : pub %prec VIS { Spanned PublicV (spanOf $1) }+ | {- empty -} %prec VIS { pure InheritedV }++stmtOrSemi :: { Maybe (Stmt Span) }+ : ';' { Nothing }+ | stmt { Just $1 }++-- List of statements where the last statement might be a no-semicolon statement.+stmts_possibly_no_semi :: { [Maybe (Stmt Span)] }+ : stmtOrSemi stmts_possibly_no_semi { $1 : $2 }+ | stmtOrSemi { [$1] }+ | many(outer_attribute) nonblock_expr { [Just (toStmt ($1 `addAttrs` $2) False False ($1 # $2))] }+ | many(outer_attribute) blockpostfix_expr { [Just (toStmt ($1 `addAttrs` $2) False True ($1 # $2))] }++initializer :: { Maybe (Expr Span) }+ : '=' expr { Just $2 }+ | {- empty -} { Nothing }++block :: { Block Span }+ : ntBlock { $1 }+ | '{' '}' { Block [] Normal ($1 # $>) }+ | '{' stmts_possibly_no_semi '}' { Block [ s | Just s <- $2 ] Normal ($1 # $>) }++inner_attrs_block :: { ([Attribute Span], Block Span) }+ : block { ([], $1) }+ | '{' inner_attrs '}' { (toList $2, Block [] Normal ($1 # $>)) }+ | '{' inner_attrs stmts_possibly_no_semi '}' { (toList $2, Block [ s | Just s <- $3 ] Normal ($1 # $>)) }+++-----------+-- Items --+-----------++-- Given the types of permitted visibilities, generate a rule for items. The reason this production+-- is useful over just having 'item :: { ItemSpan }' and then 'many(outer_attribute) vis item' is+-- that (1) not all items have visibility and (2) attributes and visibility are fields on the 'Item'+-- algebraic data type.+gen_item(vis) :: { Item Span }+ : many(outer_attribute) vis static ident ':' ty '=' expr ';'+ { Static $1 (unspan $2) (unspan $4) $6 Immutable $8 ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis static mut ident ':' ty '=' expr ';'+ { Static $1 (unspan $2) (unspan $5) $7 Mutable $9 ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis const ident ':' ty '=' expr ';'+ { ConstItem $1 (unspan $2) (unspan $4) $6 $8 ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis type ident generics where_clause '=' ty ';'+ { TyAlias $1 (unspan $2) (unspan $4) $8 ($5 `withWhere` $6) ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis use use_tree ';'+ { Use $1 (unspan $2) $4 ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis safety extern crate ident ';'+ {% noSafety $3 (ExternCrate $1 (unspan $2) (unspan $6) Nothing ($1 # $2 # $4 # $>)) }+ | many(outer_attribute) vis safety extern crate ident as ident ';'+ {% noSafety $3 (ExternCrate $1 (unspan $2) (unspan $8) (Just (unspan $6)) ($1 # $2 # $4 # $>)) }+ | many(outer_attribute) vis const safety fn ident generics fn_decl(arg_named) where_clause inner_attrs_block+ { Fn ($1 ++ fst $>) (unspan $2) (unspan $6) $8 (unspan $4) Const Rust ($7 `withWhere` $9) (snd $>) ($1 # $2 # $3 # snd $>) }+ | many(outer_attribute) vis safety extern abi fn ident generics fn_decl(arg_named) where_clause inner_attrs_block+ { Fn ($1 ++ fst $>) (unspan $2) (unspan $7) $9 (unspan $3) NotConst $5 ($8 `withWhere` $10) (snd $>) ($1 # $2 # $3 # $4 # snd $>) }+ | many(outer_attribute) vis safety fn ident generics fn_decl(arg_named) where_clause inner_attrs_block+ { Fn ($1 ++ fst $>) (unspan $2) (unspan $5) $7 (unspan $3) NotConst Rust ($6 `withWhere` $8) (snd $>) ($1 # $2 # $3 # $4 # snd $>) }+ | many(outer_attribute) vis mod ident ';'+ { Mod $1 (unspan $2) (unspan $4) Nothing ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis mod ident '{' many(mod_item) '}'+ { Mod $1 (unspan $2) (unspan $4) (Just $6) ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis mod ident '{' inner_attrs many(mod_item) '}'+ { Mod ($1 ++ toList $6) (unspan $2) (unspan $4) (Just $7) ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis safety extern abi '{' many(foreign_item) '}'+ {% noSafety $3 (ForeignMod $1 (unspan $2) $5 $7 ($1 # $2 # $4 # $>)) }+ | many(outer_attribute) vis safety extern abi '{' inner_attrs many(foreign_item) '}'+ {% noSafety $3 (ForeignMod ($1 ++ toList $7) (unspan $2) $5 $8 ($1 # $2 # $4 # $>)) }+ | many(outer_attribute) vis struct ident generics struct_decl_args+ { StructItem $1 (unspan $2) (unspan $4) (snd $6) ($5 `withWhere` fst $6) ($1 # $2 # $3 # snd $>) }+ | many(outer_attribute) vis union ident generics struct_decl_args+ { Union $1 (unspan $2) (unspan $4) (snd $6) ($5 `withWhere` fst $6) ($1 # $2 # $3 # snd $>) }+ | many(outer_attribute) vis enum ident generics where_clause '{' sep_byT(enum_def,',') '}'+ { Enum $1 (unspan $2) (unspan $4) $8 ($5 `withWhere` $6) ($1 # $2 # $3 # $>) }+ | many(outer_attribute) vis safety trait ident generics ':' sep_by1T(ty_param_bound,'+') where_clause '{' many(trait_item) '}'+ { Trait $1 (unspan $2) (unspan $5) False (unspan $3) ($6 `withWhere` $9) (toList $8) $11 ($1 # $2 # $3 # $4 # $>) }+ | many(outer_attribute) vis safety trait ident generics where_clause '{' many(trait_item) '}'+ { Trait $1 (unspan $2) (unspan $5) False (unspan $3) ($6 `withWhere` $7) [] $9 ($1 # $2 # $3 # $4 # $>) }+ | many(outer_attribute) vis safety auto trait ident generics ':' sep_by1T(ty_param_bound,'+') where_clause '{' many(trait_item) '}'+ { Trait $1 (unspan $2) (unspan $6) True (unspan $3) ($7 `withWhere` $10) (toList $9) $12 ($1 # $2 # $3 # $5 # $>) }+ | many(outer_attribute) vis safety auto trait ident generics where_clause '{' many(trait_item) '}'+ { Trait $1 (unspan $2) (unspan $6) True (unspan $3) ($7 `withWhere` $8) [] $10 ($1 # $2 # $3 # $5 # $>) }+ | many(outer_attribute) vis safety trait ident generics '=' sep_by1T(ty_param_bound,'+') ';'+ {% noSafety $3 (TraitAlias $1 (unspan $2) (unspan $5) $6 (toNonEmpty $8) ($1 # $2 # $3 # $>)) }+ | many(outer_attribute) vis safety impl generics ty_prim where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $9) (unspan $2) Final (unspan $3) Positive ($5 `withWhere` $7) Nothing $6 (snd $9) ($1 # $2 # $3 # $4 # $5 # $>) }+ | many(outer_attribute) vis default safety impl generics ty_prim where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $10) (unspan $2) Default (unspan $4) Positive ($6 `withWhere` $8) Nothing $7 (snd $10) ($1 # $2 # $3 # $4 # $5 # $>) }+ | many(outer_attribute) vis safety impl generics '(' ty_no_plus ')' where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $11) (unspan $2) Final (unspan $3) Positive ($5 `withWhere` $9) Nothing (ParenTy $7 ($6 # $8)) (snd $11) ($1 # $2 # $3 # $4 # $5 # $>) }+ | many(outer_attribute) vis default safety impl generics '(' ty_no_plus ')' where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $12) (unspan $2) Default (unspan $4) Positive ($6 `withWhere` $10) Nothing (ParenTy $8 ($7 # $9)) (snd $12) ($1 # $2 # $3 # $4 # $5 # $>) }+ | many(outer_attribute) vis safety impl generics '!' trait_ref for ty where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $12) (unspan $2) Final (unspan $3) Negative ($5 `withWhere` $10) (Just $7) $9 (snd $12) ($1 # $2 # $3 # $4 # $5 # $>) }+ | many(outer_attribute) vis default safety impl generics '!' trait_ref for ty where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $13) (unspan $2) Default (unspan $4) Negative ($6 `withWhere` $11) (Just $8) $10 (snd $13) ($1 # $2 # $3 # $4 # $5 # $>) }+ | many(outer_attribute) vis safety impl generics trait_ref for ty where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $11) (unspan $2) Final (unspan $3) Positive ($5 `withWhere` $9) (Just $6) $8 (snd $11) ($1 # $2 # $3 # $4 # $5 # $>) }+ | many(outer_attribute) vis default safety impl generics trait_ref for ty where_clause '{' impl_items '}'+ { Impl ($1 ++ fst $12) (unspan $2) Default (unspan $4) Positive ($6 `withWhere` $10) (Just $7) $9 (snd $12) ($1 # $2 # $3 # $4 # $5 # $>) }++mod_items :: { [Item Span] }+ : many(mod_item) { $1 }++-- Most general type of item+mod_item :: { Item Span }+ : ntItem { $1 }+ | gen_item(vis) { $1 }+ | many(outer_attribute) expr_path '!' ident '[' token_stream ']' ';'+ { macroItem $1 (Just (unspan $4)) (Mac $2 $6 ($2 # $>)) ($1 # $2 # $>) }+ | many(outer_attribute) expr_path '!' '[' token_stream ']' ';'+ { macroItem $1 Nothing (Mac $2 $5 ($2 # $>)) ($1 # $2 # $>) }+ | many(outer_attribute) expr_path '!' ident '(' token_stream ')' ';'+ { macroItem $1 (Just (unspan $4)) (Mac $2 $6 ($2 # $>)) ($1 # $2 # $>) }+ | many(outer_attribute) expr_path '!' '(' token_stream ')' ';'+ { macroItem $1 Nothing (Mac $2 $5 ($2 # $>)) ($1 # $2 # $>) }+ | many(outer_attribute) expr_path '!' ident '{' token_stream '}'+ { macroItem $1 (Just (unspan $4)) (Mac $2 $6 ($2 # $>)) ($1 # $2 # $>) }+ | many(outer_attribute) expr_path '!' '{' token_stream '}'+ { macroItem $1 Nothing (Mac $2 $5 ($2 # $>)) ($1 # $2 # $>) }++foreign_item :: { ForeignItem Span }+ : many(outer_attribute) vis static ident ':' ty ';'+ { ForeignStatic $1 (unspan $2) (unspan $4) $6 Immutable ($1 # $2 # $>) }+ | many(outer_attribute) vis static mut ident ':' ty ';'+ { ForeignStatic $1 (unspan $2) (unspan $5) $7 Mutable ($1 # $2 # $>) }+ | many(outer_attribute) vis fn ident generics fn_decl(arg_named) where_clause ';'+ { ForeignFn $1 (unspan $2) (unspan $4) $6 ($5 `withWhere` $7) ($1 # $2 # $>) }+ | many(outer_attribute) vis type ident ';'+ { ForeignTy $1 (unspan $2) (unspan $4) ($1 # $2 # $>) }++-- parse_generics+-- Leaves the WhereClause empty+generics :: { Generics Span }+ : ntGenerics { $1 }+ | '<' sep_by1(lifetime_def,',') ',' sep_by1T(ty_param,',') gt '>' { Generics (toList $2) (toList $4) (WhereClause [] mempty) ($1 # $>) }+ | '<' sep_by1T(lifetime_def,',') gt '>' { Generics (toList $2) [] (WhereClause [] mempty) ($1 # $>) }+ | '<' sep_by1T(ty_param,',') gt '>' { Generics [] (toList $2) (WhereClause [] mempty) ($1 # $>) }+ | '<' gt '>' { Generics [] [] (WhereClause [] mempty) ($1 # $>) }+ | {- empty -} { Generics [] [] (WhereClause [] mempty) mempty }++ty_param :: { TyParam Span }+ : many(outer_attribute) ident { TyParam $1 (unspan $2) [] Nothing ($1 # $>) }+ | many(outer_attribute) ident ':' sep_by1T(ty_param_bound_mod,'+') { TyParam $1 (unspan $2) (toList $4) Nothing ($1 # $>) }+ | many(outer_attribute) ident '=' ty { TyParam $1 (unspan $2) [] (Just $>) ($1 # $>) }+ | many(outer_attribute) ident ':' sep_by1T(ty_param_bound_mod,'+') '=' ty { TyParam $1 (unspan $2) (toList $4) (Just $>) ($1 # $>) }+++struct_decl_args :: { (WhereClause Span, VariantData Span) }+ : where_clause ';' { ($1, UnitD ($1 # $>)) }+ | where_clause '{' sep_byT(struct_decl_field,',') '}' { ($1, StructD $3 ($1 # $>)) }+ | '(' sep_byT(tuple_decl_field,',') ')' where_clause ';' { ($4, TupleD $2 ($1 # $>)) }++struct_decl_field :: { StructField Span }+ : many(outer_attribute) vis ident ':' ty { StructField (Just (unspan $3)) (unspan $2) $5 $1 ($1 # $2 # $5) }++tuple_decl_field :: { StructField Span }+ : many(outer_attribute) vis ty { StructField Nothing (unspan $2) $3 $1 ($1 # $2 # $3) }++enum_def :: { Variant Span }+ : many(outer_attribute) ident '{' sep_byT(struct_decl_field,',') '}' { Variant (unspan $2) $1 (StructD $4 ($3 # $5)) Nothing ($1 # $2 # $>) }+ | many(outer_attribute) ident '(' sep_byT(tuple_decl_field,',') ')' { Variant (unspan $2) $1 (TupleD $4 ($3 # $5)) Nothing ($1 # $2 # $>) }+ | many(outer_attribute) ident initializer { Variant (unspan $2) $1 (UnitD mempty) $3 ($1 # $2 # $>) }+++-- parse_where_clause+where_clause :: { WhereClause Span }+ : {- empty -} { WhereClause [] mempty }+ | ntWhereClause { $1 }+ | where sep_by(where_predicate,',') %prec WHERE { WhereClause $2 ($1 # $2) }+ | where sep_by1(where_predicate,',') ',' %prec WHERE { WhereClause (toList $2) ($1 # $3) }++where_predicate :: { WherePredicate Span }+ : lifetime { RegionPredicate $1 [] (spanOf $1) }+ | lifetime ':' sep_by1T(lifetime,'+') { RegionPredicate $1 (toList $3) ($1 # $3) }+ | no_for_ty %prec EQ { BoundPredicate [] $1 [] (spanOf $1) }+ | no_for_ty '=' ty { EqPredicate $1 $3 ($1 # $3) }+ | no_for_ty '==' ty { EqPredicate $1 $3 ($1 # $3) }+ | no_for_ty ':' sep_by1T(ty_param_bound_mod,'+') { BoundPredicate [] $1 (toList $3) ($1 # $3) }+ | for_lts no_for_ty { BoundPredicate (unspan $1) $2 [] ($1 # $2) }+ | for_lts no_for_ty ':' sep_by1T(ty_param_bound_mod,'+') { BoundPredicate (unspan $1) $2 (toList $4) ($1 # $>) }++impl_items :: { ([Attribute Span], [ImplItem Span]) }+ : many(impl_item) { ([], $1) }+ | inner_attrs many(impl_item) { (toList $1, $2) }++impl_item :: { ImplItem Span }+ : ntImplItem { $1 }+ | many(outer_attribute) vis def type ident '=' ty ';' { TypeI $1 (unspan $2) (unspan $3) (unspan $5) $7 ($1 # $2 # $3 # $4 # $>) }+ | many(outer_attribute) vis def const ident ':' ty '=' expr ';' { ConstI $1 (unspan $2) (unspan $3) (unspan $5) $7 $9 ($1 # $2 # $3 # $4 # $>) }+ | many(outer_attribute) def mod_mac { MacroI $1 (unspan $2) $3 ($1 # $2 # $>) }+ | many(outer_attribute) vis def const safety fn ident generics fn_decl_with_self_named where_clause inner_attrs_block+ { let methodSig = MethodSig (unspan $5) Const Rust $9; generics = $8 `withWhere` $10+ in MethodI ($1 ++ fst $>) (unspan $2) (unspan $3) (unspan $7) generics methodSig (snd $>) ($1 # $2 # $3 # $4 # snd $>) }+ | many(outer_attribute) vis def safety ext_abi fn ident generics fn_decl_with_self_named where_clause inner_attrs_block+ { let methodSig = MethodSig (unspan $4) NotConst (unspan $5) $9; generics = $8 `withWhere` $10+ in MethodI ($1 ++ fst $>) (unspan $2) (unspan $3) (unspan $7) generics methodSig (snd $>) ($1 # $2 # $3 # $4 # $5 # $6 # snd $>) }++trait_item :: { TraitItem Span }+ : ntTraitItem { $1 }+ | many(outer_attribute) const ident ':' ty initializer ';' { ConstT $1 (unspan $3) $5 $6 ($1 # $2 # $>) }+ | many(outer_attribute) mod_mac { MacroT $1 $2 ($1 # $>) }+ | many(outer_attribute) type ident ';' { TypeT $1 (unspan $3) [] Nothing ($1 # $2 # $>) }+ | many(outer_attribute) type ident '=' ty ';' { TypeT $1 (unspan $3) [] (Just $5) ($1 # $2 # $>) }+ | many(outer_attribute) type ident ':' sep_by1T(ty_param_bound_mod,'+') ';'+ { TypeT $1 (unspan $3) (toList $5) Nothing ($1 # $2 # $>) }+ | many(outer_attribute) type ident ':' sep_by1T(ty_param_bound_mod,'+') '=' ty ';'+ { TypeT $1 (unspan $3) (toList $5) (Just $7) ($1 # $2 # $>) }+ | many(outer_attribute) safety ext_abi fn ident generics fn_decl_with_self_general where_clause ';'+ { let methodSig = MethodSig (unspan $2) NotConst (unspan $3) $7; generics = $6 `withWhere` $8+ in MethodT $1 (unspan $5) generics methodSig Nothing ($1 # $2 # $3 # $4 # $>) }+ | many(outer_attribute) safety ext_abi fn ident generics fn_decl_with_self_general where_clause inner_attrs_block+ { let methodSig = MethodSig (unspan $2) NotConst (unspan $3) $7; generics = $6 `withWhere` $8+ in MethodT ($1 ++ fst $>) (unspan $5) generics methodSig (Just (snd $>)) ($1 # $2 # $3 # $4 # snd $>) }++safety :: { Spanned Unsafety }+ : {- empty -} { pure Normal }+ | unsafe { Spanned Unsafe (spanOf $1) }++ext_abi :: { Spanned Abi }+ : {- empty -} { pure Rust }+ | extern abi { Spanned $2 (spanOf $1) }++vis :: { Spanned (Visibility Span) }+ : {- empty -} %prec VIS { Spanned InheritedV mempty }+ | pub %prec VIS { Spanned PublicV (spanOf $1) }+ | pub '(' crate ')' { Spanned CrateV ($1 # $4) }+ | crate { Spanned CrateV (spanOf $1) }+ | pub '(' in mod_path ')' { Spanned (RestrictedV $4) ($1 # $5) }+ | pub '(' super ')' { Spanned (RestrictedV (Path False [PathSegment "super" Nothing (spanOf+ $3)] (spanOf $3))) ($1 # $4) }+ | pub '(' self ')' { Spanned (RestrictedV (Path False [PathSegment "self" Nothing (spanOf+ $3)] (spanOf $3))) ($1 # $4) }++def :: { Spanned Defaultness }+ : {- empty -} %prec DEF { pure Final }+ | default { Spanned Default (spanOf $1) }++use_tree :: { UseTree Span }+ : mod_path { UseTreeSimple $1 Nothing (spanOf $1) }+ | mod_path as ident { UseTreeSimple $1 (Just (unspan $3)) ($1 # $3) }+ | mod_path '::' '*' { UseTreeGlob $1 ($1 # $3) }+ | '::' '*' { UseTreeGlob (Path True [] (spanOf $1)) ($1 # $2) }+ | '*' { UseTreeGlob (Path False [] mempty) (spanOf $1) }+ | mod_path '::' '{' sep_byT(use_tree,',') '}' { UseTreeNested $1 $4 ($1 # $>) }+ | '::' '{' sep_byT(use_tree,',') '}' { UseTreeNested (Path True [] (spanOf $1)) $3 ($1 # $>) }+ | '{' sep_byT(use_tree,',') '}' { UseTreeNested (Path False [] mempty) $2 ($1 # $>) }++-------------------+-- Macro related --+-------------------++expr_mac :: { Mac Span }+ : expr_path '!' '[' token_stream ']' { Mac $1 $4 ($1 # $>) }+ | expr_path '!' '(' token_stream ')' { Mac $1 $4 ($1 # $>) }++ty_mac :: { Mac Span }+ : ty_path '!' '[' token_stream ']' { Mac $1 $4 ($1 # $>) }+ | ty_path '!' '{' token_stream '}' { Mac $1 $4 ($1 # $>) }+ | ty_path '!' '(' token_stream ')' { Mac $1 $4 ($1 # $>) }++mod_mac :: { Mac Span }+ : mod_path '!' '[' token_stream ']' ';' { Mac $1 $4 ($1 # $>) }+ | mod_path '!' '{' token_stream '}' { Mac $1 $4 ($1 # $>) }+ | mod_path '!' '(' token_stream ')' ';' { Mac $1 $4 ($1 # $>) }++token_stream :: { TokenStream }+ : {- empty -} { Stream [] }+ | some(token_tree) {+ case $1 of+ [tt] -> Tree tt+ tts -> Stream [ Tree tt | tt <- toList tts ]+ }++token_stream_no_embed :: { TokenStream }+ : {- empty -} { Stream [] }+ | some(token_tree_no_embed) {+ case $1 of+ [tt] -> Tree tt+ tts -> Stream [ Tree tt | tt <- toList tts ]+ }++token_tree :: { TokenTree }+ : ntTT { $1 }+ -- # Delimited+ | '(' token_stream ')' { Delimited ($1 # $3) Paren $2 }+ | '{' token_stream '}' { Delimited ($1 # $3) Brace $2 }+ | '[' token_stream ']' { Delimited ($1 # $3) Bracket $2 } + -- # Token+ | token { let Spanned t s = $1 in Token s t }++token :: { Spanned Token }+ : '=' { $1 }+ | '<' { $1 }+ | '>' { $1 }+ | '!' { $1 }+ | '~' { $1 }+ | '-' { $1 }+ | '/' { $1 }+ | '+' { $1 }+ | '*' { $1 }+ | '%' { $1 }+ | '^' { $1 }+ | '&' { $1 }+ | '|' { $1 }+ | '<<=' { $1 }+ | '>>=' { $1 }+ | '-=' { $1 }+ | '&=' { $1 }+ | '|=' { $1 }+ | '+=' { $1 }+ | '*=' { $1 }+ | '/=' { $1 }+ | '^=' { $1 }+ | '%=' { $1 }+ | '||' { $1 }+ | '&&' { $1 }+ | '==' { $1 }+ | '!=' { $1 }+ | '<=' { $1 }+ | '>=' { $1 }+ | '<<' { $1 }+ | '>>' { $1 }+ -- Structural symbols.+ | '@' { $1 }+ | '...' { $1 }+ | '..=' { $1 }+ | '..' { $1 }+ | '.' { $1 }+ | ',' { $1 }+ | ';' { $1 }+ | '::' { $1 }+ | ':' { $1 }+ | '->' { $1 }+ | '<-' { $1 }+ | '=>' { $1 }+ | '#' { $1 }+ | '$' { $1 }+ | '?' { $1 }+ | '#!' { $1 }+ -- Literals.+ | byte { $1 }+ | char { $1 }+ | int { $1 }+ | float { $1 }+ | str { $1 }+ | byteStr { $1 }+ | rawStr { $1 }+ | rawByteStr { $1 }+ -- Strict keywords used in the language+ | as { $1 }+ | box { $1 }+ | break { $1 }+ | const { $1 }+ | continue { $1 }+ | crate { $1 }+ | else { $1 }+ | enum { $1 }+ | extern { $1 }+ | false { $1 }+ | fn { $1 }+ | for { $1 }+ | if { $1 }+ | impl { $1 }+ | in { $1 }+ | let { $1 }+ | loop { $1 }+ | match { $1 }+ | mod { $1 }+ | move { $1 }+ | mut { $1 }+ | pub { $1 }+ | ref { $1 }+ | return { $1 }+ | Self { $1 }+ | self { $1 }+ | static { $1 }+ | struct { $1 }+ | super { $1 }+ | trait { $1 }+ | true { $1 }+ | type { $1 }+ | unsafe { $1 }+ | use { $1 }+ | where { $1 }+ | while { $1 }+ -- Keywords reserved for future use+ | abstract { $1 }+ | alignof { $1 }+ | become { $1 }+ | do { $1 }+ | final { $1 }+ | macro { $1 }+ | offsetof { $1 }+ | override { $1 }+ | priv { $1 }+ | proc { $1 }+ | pure { $1 }+ | sizeof { $1 }+ | typeof { $1 }+ | unsized { $1 }+ | virtual { $1 }+ -- Weak keywords, have special meaning only in specific contexts.+ | default { $1 }+ | union { $1 }+ | catch { $1 }+ | auto { $1 }+ | yield { $1 }+ | dyn { $1 }+ -- Comments+ | outerDoc { $1 }+ | innerDoc { $1 }+ -- Identifiers.+ | IDENT { $1 }+ | EMBEDDED_IDENT { $1 }+ | '_' { $1 }+ -- Lifetimes.+ | LIFETIME { $1 }++token_tree_no_embed :: { TokenTree }+ : ntTT { $1 }+ -- # Delimited+ | '(' token_stream_no_embed ')' { Delimited ($1 # $3) Paren $2 }+ | '{' token_stream_no_embed '}' { Delimited ($1 # $3) Brace $2 }+ | '[' token_stream_no_embed ']' { Delimited ($1 # $3) Bracket $2 } + -- # Token+ | token_no_embed { let Spanned t s = $1 in Token s t }++token_no_embed :: { Spanned Token }+ : '=' { $1 }+ | '<' { $1 }+ | '>' { $1 }+ | '!' { $1 }+ | '~' { $1 }+ | '-' { $1 }+ | '/' { $1 }+ | '+' { $1 }+ | '*' { $1 }+ | '%' { $1 }+ | '^' { $1 }+ | '&' { $1 }+ | '|' { $1 }+ | '<<=' { $1 }+ | '>>=' { $1 }+ | '-=' { $1 }+ | '&=' { $1 }+ | '|=' { $1 }+ | '+=' { $1 }+ | '*=' { $1 }+ | '/=' { $1 }+ | '^=' { $1 }+ | '%=' { $1 }+ | '||' { $1 }+ | '&&' { $1 }+ | '==' { $1 }+ | '!=' { $1 }+ | '<=' { $1 }+ | '>=' { $1 }+ | '<<' { $1 }+ | '>>' { $1 }+ -- Structural symbols.+ | '@' { $1 }+ | '...' { $1 }+ | '..=' { $1 }+ | '..' { $1 }+ | '.' { $1 }+ | ',' { $1 }+ | ';' { $1 }+ | '::' { $1 }+ | ':' { $1 }+ | '->' { $1 }+ | '<-' { $1 }+ | '=>' { $1 }+ | '#' { $1 }+ | '$' { $1 }+ | '?' { $1 }+ | '#!' { $1 }+ -- Literals.+ | byte { $1 }+ | char { $1 }+ | int { $1 }+ | float { $1 }+ | str { $1 }+ | byteStr { $1 }+ | rawStr { $1 }+ | rawByteStr { $1 }+ -- Strict keywords used in the language+ | as { $1 }+ | box { $1 }+ | break { $1 }+ | const { $1 }+ | continue { $1 }+ | crate { $1 }+ | else { $1 }+ | enum { $1 }+ | extern { $1 }+ | false { $1 }+ | fn { $1 }+ | for { $1 }+ | if { $1 }+ | impl { $1 }+ | in { $1 }+ | let { $1 }+ | loop { $1 }+ | match { $1 }+ | mod { $1 }+ | move { $1 }+ | mut { $1 }+ | pub { $1 }+ | ref { $1 }+ | return { $1 }+ | Self { $1 }+ | self { $1 }+ | static { $1 }+ | struct { $1 }+ | super { $1 }+ | trait { $1 }+ | true { $1 }+ | type { $1 }+ | unsafe { $1 }+ | use { $1 }+ | where { $1 }+ | while { $1 }+ -- Keywords reserved for future use+ | abstract { $1 }+ | alignof { $1 }+ | become { $1 }+ | do { $1 }+ | final { $1 }+ | macro { $1 }+ | offsetof { $1 }+ | override { $1 }+ | priv { $1 }+ | proc { $1 }+ | pure { $1 }+ | sizeof { $1 }+ | typeof { $1 }+ | unsized { $1 }+ | virtual { $1 }+ -- Weak keywords, have special meaning only in specific contexts.+ | default { $1 }+ | union { $1 }+ | catch { $1 }+ | auto { $1 }+ | yield { $1 }+ | dyn { $1 }+ -- Comments+ | outerDoc { $1 }+ | innerDoc { $1 }+ -- Identifiers.+ | IDENT { $1 }+ | '_' { $1 }+ -- Lifetimes.+ | LIFETIME { $1 }++---------------------+-- Just for export --+---------------------++-- These rules aren't used anywhere in the grammar above, they just provide a more general parsers.++-- Any attribute+export_attribute :: { Attribute Span }+ : inner_attribute { $1 }+ | outer_attribute { $1 }++-- Complete blocks+export_block :: { Block Span }+ : ntBlock { $1 }+ | safety '{' '}' { Block [] (unspan $1) ($1 # $2 # $>) }+ | safety '{' stmts_possibly_no_semi '}' { Block [ s | Just s <- $3 ] (unspan $1) ($1 # $2 # $>) }++{+-- | Parser for literals.+parseLit :: P (Lit Span)++-- | Parser for attributes.+parseAttr :: P (Attribute Span)++-- | Parser for types.+parseTy :: P (Ty Span)++-- | Parser for patterns.+parsePat :: P (Pat Span)++-- | Parser for statements.+parseStmt :: P (Stmt Span)++-- | Parser for expressions.+parseExpr :: P (Expr Span)++-- | Parser for items.+parseItem :: P (Item Span)++-- | Parser for blocks.+parseBlock :: P (Block Span)++-- | Parser for @impl@ items.+parseImplItem :: P (ImplItem Span)++-- | Parser for @trait@ items.+parseTraitItem :: P (TraitItem Span)++-- | Parser for token trees.+parseTt :: P TokenTree++-- | Parser for token streams.+parseTokenStream :: P TokenStream++-- | Parser for lifetime definitions.+parseLifetimeDef :: P (LifetimeDef Span)++-- | Parser for a type parameter.+parseTyParam :: P (TyParam Span)++-- | Parser for a where clause.+parseWhereClause :: P (WhereClause Span)++-- | Parser for generics (although 'WhereClause' is always empty here).+parseGenerics :: P (Generics Span)++-- | Generate a nice looking error message based on expected tokens+expParseError :: (Spanned Token, [String]) -> P a+expParseError (Spanned t _, exps) = fail $ "Syntax error: unexpected `" ++ show t ++ "'" +++ case go (sort exps) [] replacements of+ [] -> ""+ [s] -> " (expected " ++ s ++ ")"+ [s2,s1] -> " (expected " ++ s1 ++ " or " ++ s2 ++ ")"+ (s : ss) -> " (expected " ++ (reverse ss >>= (++ ", ")) ++ "or " ++ s ++ ")"+ where++ go [] msgs _ = msgs+ go (e:es) msgs rs | e `elem` ignore = go es msgs rs+ go (e:es) msgs [] = go es (e : msgs) []+ go es msgs ((rep,msg):rs)+ | rep `isSubsequenceOf` es = go (es \\ rep) (msg : msgs) rs+ | otherwise = go es msgs rs++ ignore = words "ntItem ntBlock ntStmt ntPat ntExpr ntTy ntIdent ntPath ntTT" +++ words "ntArm ntImplItem ntTraitItem ntGenerics ntWhereClause ntArg ntLit"++ replacements = map (\(ks,v) -> (sort ks,v)) $+ [ (expr, "an expression" )++ , (lit, "a literal" )+ , (boolLit, "a boolean" )+ , (byteLit, "a byte" )+ , (charLit, "a character" )+ , (intLit, "an int" )+ , (floatLit, "a float" )+ , (strLit, "a string" )+ , (byteStrLit, "a byte string" )+ , (rawStrLit, "a raw string" )+ , (rawByteStrLit, "a raw bytestring")+ + , (doc, "a doc" )+ , (outerDoc, "an outer doc" )+ , (innerDoc, "an inner doc" )++ , (identifier, "an identifier" )+ , (lifetime, "a lifetime" )+ ]++ expr :: [String]+ expr = lit ++ identifier ++ lifetime +++ words "'<' '!' '-' '*' '&' '|' '...' '..=' '..' '::'" +++ words "'||' '&&' '<<' '(' '[' '{' box break continue" +++ words "for if loop match move return Self self " +++ words "static super unsafe while do default union " +++ words "catch auto yield dyn"++ lit = boolLit ++ byteLit ++ charLit ++ intLit ++ floatLit ++ strLit +++ byteStrLit ++ rawStrLit ++ rawByteStrLit+ boolLit = words "true false"+ byteLit = words "byte"+ charLit = words "char"+ intLit = words "int"+ floatLit = words "float"+ strLit = words "str"+ byteStrLit = words "byteStr"+ rawStrLit = words "rawStr"+ rawByteStrLit = words "rawByteStr"+ + doc = outerDoc ++ innerDoc+ outerDoc = words "outerDoc"+ innerDoc = words "innerDoc"++ identifier = words "IDENT"+ lifetime = words "LIFETIME"++-- | Convert an 'IdentTok' into an 'Ident'+toIdent :: Spanned Token -> Spanned Ident+toIdent (Spanned (IdentTok i) s) = Spanned i s++toEmbedded :: [Attribute Span] -> Spanned Token -> Expr Span+toEmbedded as (Spanned (EmbeddedCode c) s) = EmbeddedExpr as c s++-- | Try to convert an expression to a statement given information about whether there is a trailing+-- semicolon+toStmt :: Expr Span -> Bool -> Bool -> Span -> Stmt Span+toStmt (MacExpr a m s) hasSemi isBlock | hasSemi = MacStmt m SemicolonMac a+ | isBlock = MacStmt m BracesMac a+toStmt e hasSemi _ = (if hasSemi then Semi else NoSemi) e++-- | Return the second argument, as long as the visibility is 'InheritedV'+noVis :: Spanned (Visibility Span) -> a -> P a+noVis (Spanned InheritedV _) x = pure x+noVis _ _ = fail "visibility is not allowed here"++-- | Fill in the where clause in a generic+withWhere :: Generics a -> WhereClause a -> Generics a+withWhere (Generics l t _ x) w = Generics l t w x++-- | Return the second argument, as long as the safety is 'Normal'+noSafety :: Spanned Unsafety -> a -> P a+noSafety (Spanned Normal _) x = pure x+noSafety _ _ = fail "safety is not allowed here"++-- | Make a macro item, which may be a 'MacroDef'+macroItem :: [Attribute Span] -> (Maybe Ident) -> Mac Span -> Span -> Item Span+macroItem as (Just i) (Mac (Path False [PathSegment "macro_rules" Nothing _] _) tts _) x = MacroDef as i tts x+macroItem as i mac x = MacItem as i mac x++-- | Add attributes to an expression+addAttrs :: [Attribute Span] -> Expr Span -> Expr Span+addAttrs as (Box as' e s) = Box (as ++ as') e s+addAttrs as (InPlace as' e1 e2 s) = InPlace (as ++ as') e1 e2 s+addAttrs as (Vec as' e s) = Vec (as ++ as') e s+addAttrs as (Call as' f es s) = Call (as ++ as') f es s+addAttrs as (MethodCall as' i s tys es s') = MethodCall (as ++ as') i s tys es s'+addAttrs as (TupExpr as' e s) = TupExpr (as ++ as') e s+addAttrs as (Binary as' b e1 e2 s) = Binary (as ++ as') b e1 e2 s+addAttrs as (Unary as' u e s) = Unary (as ++ as') u e s+addAttrs as (Lit as' l s) = Lit (as ++ as') l s+addAttrs as (Cast as' e t s) = Cast (as ++ as') e t s+addAttrs as (TypeAscription as' e t s) = TypeAscription (as ++ as') e t s+addAttrs as (If as' e1 b b2 s) = If (as ++ as') e1 b b2 s+addAttrs as (IfLet as' p e b em s) = IfLet (as ++ as') p e b em s+addAttrs as (While as' e b l s) = While (as ++ as') e b l s+addAttrs as (WhileLet as' p e b l s) = WhileLet (as ++ as') p e b l s+addAttrs as (ForLoop as' p e b l s) = ForLoop (as ++ as') p e b l s+addAttrs as (Loop as' b l s) = Loop (as ++ as') b l s+addAttrs as (Match as' e a s) = Match (as ++ as') e a s+addAttrs as (Closure as' m c f e s) = Closure (as ++ as') m c f e s+addAttrs as (BlockExpr as' b s) = BlockExpr (as ++ as') b s+addAttrs as (Catch as' b s) = Catch (as ++ as') b s+addAttrs as (Assign as' e1 e2 s) = Assign (as ++ as') e1 e2 s+addAttrs as (AssignOp as' b e1 e2 s) = AssignOp (as ++ as') b e1 e2 s+addAttrs as (FieldAccess as' e i s) = FieldAccess (as ++ as') e i s+addAttrs as (TupField as' e i s) = TupField (as ++ as') e i s+addAttrs as (Index as' e1 e2 s) = Index (as ++ as') e1 e2 s+addAttrs as (Range as' e1 e2 r s) = Range (as ++ as') e1 e2 r s+addAttrs as (PathExpr as' q p s) = PathExpr (as ++ as') q p s+addAttrs as (AddrOf as' m e s) = AddrOf (as ++ as') m e s+addAttrs as (Break as' l e s) = Break (as ++ as') l e s+addAttrs as (Continue as' l s) = Continue (as ++ as') l s+addAttrs as (Ret as' e s) = Ret (as ++ as') e s+addAttrs as (MacExpr as' m s) = MacExpr (as ++ as') m s+addAttrs as (Struct as' p f e a) = Struct (as ++ as') p f e a+addAttrs as (Repeat as' e1 e2 s) = Repeat (as ++ as') e1 e2 s+addAttrs as (ParenExpr as' e s) = ParenExpr (as ++ as') e s+addAttrs as (Try as' e s) = Try (as ++ as') e s+addAttrs as (Yield as' e s) = Yield (as ++ as') e s+++-- | Given a 'LitTok' token that is expected to result in a valid literal, construct the associated+-- literal. Note that this should _never_ fail on a token produced by the lexer.+lit :: Spanned Token -> Lit Span+lit (Spanned (IdentTok (Ident (Name "true") False _)) s) = Bool True Unsuffixed s+lit (Spanned (IdentTok (Ident (Name "false") False _)) s) = Bool False Unsuffixed s+lit (Spanned (LiteralTok litTok suffix_m) s) = translateLit litTok suffix s+ where+ suffix = case suffix_m of+ Nothing -> Unsuffixed+ (Just "isize") -> Is+ (Just "usize") -> Us+ (Just "i8") -> I8+ (Just "u8") -> U8+ (Just "i16") -> I16+ (Just "u16") -> U16+ (Just "i32") -> I32+ (Just "u32") -> U32+ (Just "i64") -> I64+ (Just "u64") -> U64+ (Just "i128") -> I128+ (Just "u128") -> U128+ (Just "f32") -> F32+ (Just "f64") -> F64+ _ -> error "invalid literal"++isTraitTyParamBound TraitTyParamBound{} = True+isTraitTyParamBound _ = False++-- | Parse a source file+parseSourceFile :: P (SourceFile Span)+parseSourceFile = do+ sh <- lexShebangLine+ (as,items) <- parseSourceFileContents+ pure (SourceFile sh as items)++-- | Nudge the span endpoints of a 'Span' value+nudge :: Int -> Int -> Span -> Span+nudge leftSide rightSide (Span l r) = Span l' r'+ where l' = incPos l leftSide+ r' = incPos r rightSide++}
+ src/Language/Rust/Parser/Lexer.x view
@@ -0,0 +1,1321 @@+{+{-|+Module : Language.Rust.Parser.Lexer+Description : Rust lexer+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++As much as possible, this follows Rust's choices for tokenization, including punting some things to+the parser. For instance, the last two @>@ in @Vec\<Option\<i32\>\>@ are lexed as a single+'GreaterGreater' token while the last two tokens of @Vec\<Option\<Option\<i32\>\>\>@ are+'GreaterGreater' and 'Greater'.++Yet weirder (but very useful in parsing for dealing with conflicts and precedences of logical and,+bitwise and, and unary reference), @&&&x&&&y@ lexes into 'AmpersandAmpersand', 'Ampersand',+@'IdentTok' "x"@, 'AmpersandAmpersand', 'Ampersand', @'IdentTok' "y"@. Although the parser sometimes+needs to "break apart" tokens, it never has to think about putting them together. That means it can+easily figure out that @&&&x&&&y@ parses as @&(&(&x)) && (&y)@ and not @&(&(&x)) & (&(&y))@ even if+bitwise conjunctions bind more tightly that logical conjunctions. ++This sort of amguity where one token need to be broken up by the parser occurs for++ * @&&@ in patterns like @&&mut x@+ * @||@ in closures with no arguments like @|| x@+ * @<<@ in qualified type paths like @FromIterator\<\<A as IntoIterator\>::Item\>@+ * @>>@ in qualified paths like @\<Self as Foo\<T\>\>::Bar@+ * @>=@ in equality predicates like @F\<A\>=i32@+ * @>>=@ in equality predicates like @F\<G\<A\>\>=i32@ +-}++module Language.Rust.Parser.Lexer (+ -- * Lexing+ lexToken,+ lexNonSpace,+ lexTokens,+ lexShebangLine,++ -- * Tokens+ Token(..),++ -- * Error reporting+ lexicalError,+) where++import Language.Rust.Data.Ident ( mkIdent, Ident(..), IdentName(..) )+import Language.Rust.Data.InputStream+import Language.Rust.Data.Position+import Language.Rust.Parser.ParseMonad+import Language.Rust.Syntax.Token++import Data.Char ( chr )+import Data.Word ( Word8 )++-- Things to review:+-- * improved error messages++-- Based heavily on:+-- * <https://github.com/rust-lang/rust/blob/master/src/grammar/RustLexer.g4>+-- * <https://github.com/rust-lang/rust/blob/master/src/grammar/xidstart.g4>+-- * <https://github.com/rust-lang/rust/blob/master/src/grammar/xidcontinue.g4>++}++-- XID_START unicode character class+@xid_start+ = [\x0041-\x005a]+ | "_"+ | [\x0061-\x007a]+ | \x00aa+ | \x00b5+ | \x00ba+ | [\x00c0-\x00d6]+ | [\x00d8-\x00f6]+ | [\x00f8-\x0236]+ | [\x0250-\x02c1]+ | [\x02c6-\x02d1]+ | [\x02e0-\x02e4]+ | \x02ee+ | \x0386+ | [\x0388-\x038a]+ | \x038c+ | [\x038e-\x03a1]+ | [\x03a3-\x03ce]+ | [\x03d0-\x03f5]+ | [\x03f7-\x03fb]+ | [\x0400-\x0481]+ | [\x048a-\x04ce]+ | [\x04d0-\x04f5]+ | [\x04f8-\x04f9]+ | [\x0500-\x050f]+ | [\x0531-\x0556]+ | \x0559+ | [\x0561-\x0587]+ | [\x05d0-\x05ea]+ | [\x05f0-\x05f2]+ | [\x0621-\x063a]+ | [\x0640-\x064a]+ | [\x066e-\x066f]+ | [\x0671-\x06d3]+ | \x06d5+ | [\x06e5-\x06e6]+ | [\x06ee-\x06ef]+ | [\x06fa-\x06fc]+ | \x06ff+ | \x0710+ | [\x0712-\x072f]+ | [\x074d-\x074f]+ | [\x0780-\x07a5]+ | \x07b1+ | [\x0904-\x0939]+ | \x093d+ | \x0950+ | [\x0958-\x0961]+ | [\x0985-\x098c]+ | [\x098f-\x0990]+ | [\x0993-\x09a8]+ | [\x09aa-\x09b0]+ | \x09b2+ | [\x09b6-\x09b9]+ | \x09bd+ | [\x09dc-\x09dd]+ | [\x09df-\x09e1]+ | [\x09f0-\x09f1]+ | [\x0a05-\x0a0a]+ | [\x0a0f-\x0a10]+ | [\x0a13-\x0a28]+ | [\x0a2a-\x0a30]+ | [\x0a32-\x0a33]+ | [\x0a35-\x0a36]+ | [\x0a38-\x0a39]+ | [\x0a59-\x0a5c]+ | \x0a5e+ | [\x0a72-\x0a74]+ | [\x0a85-\x0a8d]+ | [\x0a8f-\x0a91]+ | [\x0a93-\x0aa8]+ | [\x0aaa-\x0ab0]+ | [\x0ab2-\x0ab3]+ | [\x0ab5-\x0ab9]+ | \x0abd+ | \x0ad0+ | [\x0ae0-\x0ae1]+ | [\x0b05-\x0b0c]+ | [\x0b0f-\x0b10]+ | [\x0b13-\x0b28]+ | [\x0b2a-\x0b30]+ | [\x0b32-\x0b33]+ | [\x0b35-\x0b39]+ | \x0b3d+ | [\x0b5c-\x0b5d]+ | [\x0b5f-\x0b61]+ | \x0b71+ | \x0b83+ | [\x0b85-\x0b8a]+ | [\x0b8e-\x0b90]+ | [\x0b92-\x0b95]+ | [\x0b99-\x0b9a]+ | \x0b9c+ | [\x0b9e-\x0b9f]+ | [\x0ba3-\x0ba4]+ | [\x0ba8-\x0baa]+ | [\x0bae-\x0bb5]+ | [\x0bb7-\x0bb9]+ | [\x0c05-\x0c0c]+ | [\x0c0e-\x0c10]+ | [\x0c12-\x0c28]+ | [\x0c2a-\x0c33]+ | [\x0c35-\x0c39]+ | [\x0c60-\x0c61]+ | [\x0c85-\x0c8c]+ | [\x0c8e-\x0c90]+ | [\x0c92-\x0ca8]+ | [\x0caa-\x0cb3]+ | [\x0cb5-\x0cb9]+ | \x0cbd+ | \x0cde+ | [\x0ce0-\x0ce1]+ | [\x0d05-\x0d0c]+ | [\x0d0e-\x0d10]+ | [\x0d12-\x0d28]+ | [\x0d2a-\x0d39]+ | [\x0d60-\x0d61]+ | [\x0d85-\x0d96]+ | [\x0d9a-\x0db1]+ | [\x0db3-\x0dbb]+ | \x0dbd+ | [\x0dc0-\x0dc6]+ | [\x0e01-\x0e30]+ | \x0e32+ | [\x0e40-\x0e46]+ | [\x0e81-\x0e82]+ | \x0e84+ | [\x0e87-\x0e88]+ | \x0e8a+ | \x0e8d+ | [\x0e94-\x0e97]+ | [\x0e99-\x0e9f]+ | [\x0ea1-\x0ea3]+ | \x0ea5+ | \x0ea7+ | [\x0eaa-\x0eab]+ | [\x0ead-\x0eb0]+ | \x0eb2+ | \x0ebd+ | [\x0ec0-\x0ec4]+ | \x0ec6+ | [\x0edc-\x0edd]+ | \x0f00+ | [\x0f40-\x0f47]+ | [\x0f49-\x0f6a]+ | [\x0f88-\x0f8b]+ | [\x1000-\x1021]+ | [\x1023-\x1027]+ | [\x1029-\x102a]+ | [\x1050-\x1055]+ | [\x10a0-\x10c5]+ | [\x10d0-\x10f8]+ | [\x1100-\x1159]+ | [\x115f-\x11a2]+ | [\x11a8-\x11f9]+ | [\x1200-\x1206]+ | [\x1208-\x1246]+ | \x1248+ | [\x124a-\x124d]+ | [\x1250-\x1256]+ | \x1258+ | [\x125a-\x125d]+ | [\x1260-\x1286]+ | \x1288+ | [\x128a-\x128d]+ | [\x1290-\x12ae]+ | \x12b0+ | [\x12b2-\x12b5]+ | [\x12b8-\x12be]+ | \x12c0+ | [\x12c2-\x12c5]+ | [\x12c8-\x12ce]+ | [\x12d0-\x12d6]+ | [\x12d8-\x12ee]+ | [\x12f0-\x130e]+ | \x1310+ | [\x1312-\x1315]+ | [\x1318-\x131e]+ | [\x1320-\x1346]+ | [\x1348-\x135a]+ | [\x13a0-\x13f4]+ | [\x1401-\x166c]+ | [\x166f-\x1676]+ | [\x1681-\x169a]+ | [\x16a0-\x16ea]+ | [\x16ee-\x16f0]+ | [\x1700-\x170c]+ | [\x170e-\x1711]+ | [\x1720-\x1731]+ | [\x1740-\x1751]+ | [\x1760-\x176c]+ | [\x176e-\x1770]+ | [\x1780-\x17b3]+ | \x17d7+ | \x17dc+ | [\x1820-\x1877]+ | [\x1880-\x18a8]+ | [\x1900-\x191c]+ | [\x1950-\x196d]+ | [\x1970-\x1974]+ | [\x1d00-\x1d6b]+ | [\x1e00-\x1e9b]+ | [\x1ea0-\x1ef9]+ | [\x1f00-\x1f15]+ | [\x1f18-\x1f1d]+ | [\x1f20-\x1f45]+ | [\x1f48-\x1f4d]+ | [\x1f50-\x1f57]+ | \x1f59+ | \x1f5b+ | \x1f5d+ | [\x1f5f-\x1f7d]+ | [\x1f80-\x1fb4]+ | [\x1fb6-\x1fbc]+ | \x1fbe+ | [\x1fc2-\x1fc4]+ | [\x1fc6-\x1fcc]+ | [\x1fd0-\x1fd3]+ | [\x1fd6-\x1fdb]+ | [\x1fe0-\x1fec]+ | [\x1ff2-\x1ff4]+ | [\x1ff6-\x1ffc]+ | \x2071+ | \x207f+ | \x2102+ | \x2107+ | [\x210a-\x2113]+ | \x2115+ | [\x2118-\x211d]+ | \x2124+ | \x2126+ | \x2128+ | [\x212a-\x2131]+ | [\x2133-\x2139]+ | [\x213d-\x213f]+ | [\x2145-\x2149]+ | [\x2160-\x2183]+ | [\x3005-\x3007]+ | [\x3021-\x3029]+ | [\x3031-\x3035]+ | [\x3038-\x303c]+ | [\x3041-\x3096]+ | [\x309d-\x309f]+ | [\x30a1-\x30fa]+ | [\x30fc-\x30ff]+ | [\x3105-\x312c]+ | [\x3131-\x318e]+ | [\x31a0-\x31b7]+ | [\x31f0-\x31ff]+ | [\x3400-\x4db5]+ | [\x4e00-\x9fa5]+ | [\xa000-\xa48c]+ | [\xac00-\xd7a3]+ | [\xf900-\xfa2d]+ | [\xfa30-\xfa6a]+ | [\xfb00-\xfb06]+ | [\xfb13-\xfb17]+ | \xfb1d+ | [\xfb1f-\xfb28]+ | [\xfb2a-\xfb36]+ | [\xfb38-\xfb3c]+ | \xfb3e+ | [\xfb40-\xfb41]+ | [\xfb43-\xfb44]+ | [\xfb46-\xfbb1]+ | [\xfbd3-\xfc5d]+ | [\xfc64-\xfd3d]+ | [\xfd50-\xfd8f]+ | [\xfd92-\xfdc7]+ | [\xfdf0-\xfdf9]+ | \xfe71+ | \xfe73+ | \xfe77+ | \xfe79+ | \xfe7b+ | \xfe7d+ | [\xfe7f-\xfefc]+ | [\xff21-\xff3a]+ | [\xff41-\xff5a]+ | [\xff66-\xff9d]+ | [\xffa0-\xffbe]+ | [\xffc2-\xffc7]+ | [\xffca-\xffcf]+ | [\xffd2-\xffd7]+ | [\xffda-\xffdc]+ | \xd800 [\xdc00-\xdc0a]+ | \xd800 [\xdc0d-\xdc25]+ | \xd800 [\xdc28-\xdc39]+ | \xd800 [\xdc3c-\xdc3c]+ | \xd800 [\xdc3f-\xdc4c]+ | \xd800 [\xdc50-\xdc5c]+ | \xd800 [\xdc80-\xdcf9]+ | \xd800 [\xdf00-\xdf1d]+ | \xd800 [\xdf30-\xdf49]+ | \xd800 [\xdf80-\xdf9c]+ | \xd801 [\xe000-\xe09c]+ | \xd802 [\xe400-\xe404]+ | \xd802 \x0808+ | \xd802 [\xe40a-\xe434]+ | \xd802 [\xe437-\xe437]+ | \xd802 \x083c+ | \xd802 \x083f+ | \xd835 [\xb000-\xb053]+ | \xd835 [\xb056-\xb09b]+ | \xd835 [\xb09e-\xb09e]+ | \xd835 \xd4a2+ | \xd835 [\xb0a5-\xb0a5]+ | \xd835 [\xb0a9-\xb0ab]+ | \xd835 [\xb0ae-\xb0b8]+ | \xd835 \xd4bb+ | \xd835 [\xb0bd-\xb0c2]+ | \xd835 [\xb0c5-\xb104]+ | \xd835 [\xb107-\xb109]+ | \xd835 [\xb10d-\xb113]+ | \xd835 [\xb116-\xb11b]+ | \xd835 [\xb11e-\xb138]+ | \xd835 [\xb13b-\xb13d]+ | \xd835 [\xb140-\xb143]+ | \xd835 \xd546+ | \xd835 [\xb14a-\xb14f]+ | \xd835 [\xb152-\xb2a2]+ | \xd835 [\xb2a8-\xb2bf]+ | \xd835 [\xb2c2-\xb2d9]+ | \xd835 [\xb2dc-\xb2f9]+ | \xd835 [\xb2fc-\xb313]+ | \xd835 [\xb316-\xb333]+ | \xd835 [\xb336-\xb34d]+ | \xd835 [\xb350-\xb36d]+ | \xd835 [\xb370-\xb387]+ | \xd835 [\xb38a-\xb3a7]+ | \xd835 [\xb3aa-\xb3c1]+ | \xd835 [\xb3c4-\xb3c8]+ | \xd840 [\xdc00-\xdffe]+ | \xd841 [\xe000-\xe3fe]+ | \xd842 [\xe400-\xe7fe]+ | \xd843 [\xe800-\xebfe]+ | \xd844 [\xec00-\xeffe]+ | \xd845 [\xf000-\xf3fe]+ | \xd846 [\xf400-\xf7fe]+ | \xd847 [\xf800-\xfbfe]+ | \xd848 [\xfc00-\xfffe]+ | \xd849 [\x0000-\x03fe]+ | \xd84a [\x0400-\x07fe]+ | \xd84b [\x0800-\x0bfe]+ | \xd84c [\x0c00-\x0ffe]+ | \xd84d [\x1000-\x13fe]+ | \xd84e [\x1400-\x17fe]+ | \xd84f [\x1800-\x1bfe]+ | \xd850 [\x1c00-\x1ffe]+ | \xd851 [\x2000-\x23fe]+ | \xd852 [\x2400-\x27fe]+ | \xd853 [\x2800-\x2bfe]+ | \xd854 [\x2c00-\x2ffe]+ | \xd855 [\x3000-\x33fe]+ | \xd856 [\x3400-\x37fe]+ | \xd857 [\x3800-\x3bfe]+ | \xd858 [\x3c00-\x3ffe]+ | \xd859 [\x4000-\x43fe]+ | \xd85a [\x4400-\x47fe]+ | \xd85b [\x4800-\x4bfe]+ | \xd85c [\x4c00-\x4ffe]+ | \xd85d [\x5000-\x53fe]+ | \xd85e [\x5400-\x57fe]+ | \xd85f [\x5800-\x5bfe]+ | \xd860 [\x5c00-\x5ffe]+ | \xd861 [\x6000-\x63fe]+ | \xd862 [\x6400-\x67fe]+ | \xd863 [\x6800-\x6bfe]+ | \xd864 [\x6c00-\x6ffe]+ | \xd865 [\x7000-\x73fe]+ | \xd866 [\x7400-\x77fe]+ | \xd867 [\x7800-\x7bfe]+ | \xd868 [\x7c00-\x7ffe]+ | \xd869 [\x8000-\x82d5]+ | \xd87e [\xd400-\xd61c]++-- XID_CONTINUE unicode character class+@xid_continue+ = [\x0030-\x0039]+ | [\x0041-\x005a]+ | \x005f+ | [\x0061-\x007a]+ | \x00aa+ | \x00b5+ | \x00b7+ | \x00ba+ | [\x00c0-\x00d6]+ | [\x00d8-\x00f6]+ | [\x00f8-\x0236]+ | [\x0250-\x02c1]+ | [\x02c6-\x02d1]+ | [\x02e0-\x02e4]+ | \x02ee+ | [\x0300-\x0357]+ | [\x035d-\x036f]+ | \x0386+ | [\x0388-\x038a]+ | \x038c+ | [\x038e-\x03a1]+ | [\x03a3-\x03ce]+ | [\x03d0-\x03f5]+ | [\x03f7-\x03fb]+ | [\x0400-\x0481]+ | [\x0483-\x0486]+ | [\x048a-\x04ce]+ | [\x04d0-\x04f5]+ | [\x04f8-\x04f9]+ | [\x0500-\x050f]+ | [\x0531-\x0556]+ | \x0559+ | [\x0561-\x0587]+ | [\x0591-\x05a1]+ | [\x05a3-\x05b9]+ | [\x05bb-\x05bd]+ | \x05bf+ | [\x05c1-\x05c2]+ | \x05c4+ | [\x05d0-\x05ea]+ | [\x05f0-\x05f2]+ | [\x0610-\x0615]+ | [\x0621-\x063a]+ | [\x0640-\x0658]+ | [\x0660-\x0669]+ | [\x066e-\x06d3]+ | [\x06d5-\x06dc]+ | [\x06df-\x06e8]+ | [\x06ea-\x06fc]+ | \x06ff+ | [\x0710-\x074a]+ | [\x074d-\x074f]+ | [\x0780-\x07b1]+ | [\x0901-\x0939]+ | [\x093c-\x094d]+ | [\x0950-\x0954]+ | [\x0958-\x0963]+ | [\x0966-\x096f]+ | [\x0981-\x0983]+ | [\x0985-\x098c]+ | [\x098f-\x0990]+ | [\x0993-\x09a8]+ | [\x09aa-\x09b0]+ | \x09b2+ | [\x09b6-\x09b9]+ | [\x09bc-\x09c4]+ | [\x09c7-\x09c8]+ | [\x09cb-\x09cd]+ | \x09d7+ | [\x09dc-\x09dd]+ | [\x09df-\x09e3]+ | [\x09e6-\x09f1]+ | [\x0a01-\x0a03]+ | [\x0a05-\x0a0a]+ | [\x0a0f-\x0a10]+ | [\x0a13-\x0a28]+ | [\x0a2a-\x0a30]+ | [\x0a32-\x0a33]+ | [\x0a35-\x0a36]+ | [\x0a38-\x0a39]+ | \x0a3c+ | [\x0a3e-\x0a42]+ | [\x0a47-\x0a48]+ | [\x0a4b-\x0a4d]+ | [\x0a59-\x0a5c]+ | \x0a5e+ | [\x0a66-\x0a74]+ | [\x0a81-\x0a83]+ | [\x0a85-\x0a8d]+ | [\x0a8f-\x0a91]+ | [\x0a93-\x0aa8]+ | [\x0aaa-\x0ab0]+ | [\x0ab2-\x0ab3]+ | [\x0ab5-\x0ab9]+ | [\x0abc-\x0ac5]+ | [\x0ac7-\x0ac9]+ | [\x0acb-\x0acd]+ | \x0ad0+ | [\x0ae0-\x0ae3]+ | [\x0ae6-\x0aef]+ | [\x0b01-\x0b03]+ | [\x0b05-\x0b0c]+ | [\x0b0f-\x0b10]+ | [\x0b13-\x0b28]+ | [\x0b2a-\x0b30]+ | [\x0b32-\x0b33]+ | [\x0b35-\x0b39]+ | [\x0b3c-\x0b43]+ | [\x0b47-\x0b48]+ | [\x0b4b-\x0b4d]+ | [\x0b56-\x0b57]+ | [\x0b5c-\x0b5d]+ | [\x0b5f-\x0b61]+ | [\x0b66-\x0b6f]+ | \x0b71+ | [\x0b82-\x0b83]+ | [\x0b85-\x0b8a]+ | [\x0b8e-\x0b90]+ | [\x0b92-\x0b95]+ | [\x0b99-\x0b9a]+ | \x0b9c+ | [\x0b9e-\x0b9f]+ | [\x0ba3-\x0ba4]+ | [\x0ba8-\x0baa]+ | [\x0bae-\x0bb5]+ | [\x0bb7-\x0bb9]+ | [\x0bbe-\x0bc2]+ | [\x0bc6-\x0bc8]+ | [\x0bca-\x0bcd]+ | \x0bd7+ | [\x0be7-\x0bef]+ | [\x0c01-\x0c03]+ | [\x0c05-\x0c0c]+ | [\x0c0e-\x0c10]+ | [\x0c12-\x0c28]+ | [\x0c2a-\x0c33]+ | [\x0c35-\x0c39]+ | [\x0c3e-\x0c44]+ | [\x0c46-\x0c48]+ | [\x0c4a-\x0c4d]+ | [\x0c55-\x0c56]+ | [\x0c60-\x0c61]+ | [\x0c66-\x0c6f]+ | [\x0c82-\x0c83]+ | [\x0c85-\x0c8c]+ | [\x0c8e-\x0c90]+ | [\x0c92-\x0ca8]+ | [\x0caa-\x0cb3]+ | [\x0cb5-\x0cb9]+ | [\x0cbc-\x0cc4]+ | [\x0cc6-\x0cc8]+ | [\x0cca-\x0ccd]+ | [\x0cd5-\x0cd6]+ | \x0cde+ | [\x0ce0-\x0ce1]+ | [\x0ce6-\x0cef]+ | [\x0d02-\x0d03]+ | [\x0d05-\x0d0c]+ | [\x0d0e-\x0d10]+ | [\x0d12-\x0d28]+ | [\x0d2a-\x0d39]+ | [\x0d3e-\x0d43]+ | [\x0d46-\x0d48]+ | [\x0d4a-\x0d4d]+ | \x0d57+ | [\x0d60-\x0d61]+ | [\x0d66-\x0d6f]+ | [\x0d82-\x0d83]+ | [\x0d85-\x0d96]+ | [\x0d9a-\x0db1]+ | [\x0db3-\x0dbb]+ | \x0dbd+ | [\x0dc0-\x0dc6]+ | \x0dca+ | [\x0dcf-\x0dd4]+ | \x0dd6+ | [\x0dd8-\x0ddf]+ | [\x0df2-\x0df3]+ | [\x0e01-\x0e3a]+ | [\x0e40-\x0e4e]+ | [\x0e50-\x0e59]+ | [\x0e81-\x0e82]+ | \x0e84+ | [\x0e87-\x0e88]+ | \x0e8a+ | \x0e8d+ | [\x0e94-\x0e97]+ | [\x0e99-\x0e9f]+ | [\x0ea1-\x0ea3]+ | \x0ea5+ | \x0ea7+ | [\x0eaa-\x0eab]+ | [\x0ead-\x0eb9]+ | [\x0ebb-\x0ebd]+ | [\x0ec0-\x0ec4]+ | \x0ec6+ | [\x0ec8-\x0ecd]+ | [\x0ed0-\x0ed9]+ | [\x0edc-\x0edd]+ | \x0f00+ | [\x0f18-\x0f19]+ | [\x0f20-\x0f29]+ | \x0f35+ | \x0f37+ | \x0f39+ | [\x0f3e-\x0f47]+ | [\x0f49-\x0f6a]+ | [\x0f71-\x0f84]+ | [\x0f86-\x0f8b]+ | [\x0f90-\x0f97]+ | [\x0f99-\x0fbc]+ | \x0fc6+ | [\x1000-\x1021]+ | [\x1023-\x1027]+ | [\x1029-\x102a]+ | [\x102c-\x1032]+ | [\x1036-\x1039]+ | [\x1040-\x1049]+ | [\x1050-\x1059]+ | [\x10a0-\x10c5]+ | [\x10d0-\x10f8]+ | [\x1100-\x1159]+ | [\x115f-\x11a2]+ | [\x11a8-\x11f9]+ | [\x1200-\x1206]+ | [\x1208-\x1246]+ | \x1248+ | [\x124a-\x124d]+ | [\x1250-\x1256]+ | \x1258+ | [\x125a-\x125d]+ | [\x1260-\x1286]+ | \x1288+ | [\x128a-\x128d]+ | [\x1290-\x12ae]+ | \x12b0+ | [\x12b2-\x12b5]+ | [\x12b8-\x12be]+ | \x12c0+ | [\x12c2-\x12c5]+ | [\x12c8-\x12ce]+ | [\x12d0-\x12d6]+ | [\x12d8-\x12ee]+ | [\x12f0-\x130e]+ | \x1310+ | [\x1312-\x1315]+ | [\x1318-\x131e]+ | [\x1320-\x1346]+ | [\x1348-\x135a]+ | [\x1369-\x1371]+ | [\x13a0-\x13f4]+ | [\x1401-\x166c]+ | [\x166f-\x1676]+ | [\x1681-\x169a]+ | [\x16a0-\x16ea]+ | [\x16ee-\x16f0]+ | [\x1700-\x170c]+ | [\x170e-\x1714]+ | [\x1720-\x1734]+ | [\x1740-\x1753]+ | [\x1760-\x176c]+ | [\x176e-\x1770]+ | [\x1772-\x1773]+ | [\x1780-\x17b3]+ | [\x17b6-\x17d3]+ | \x17d7+ | [\x17dc-\x17dd]+ | [\x17e0-\x17e9]+ | [\x180b-\x180d]+ | [\x1810-\x1819]+ | [\x1820-\x1877]+ | [\x1880-\x18a9]+ | [\x1900-\x191c]+ | [\x1920-\x192b]+ | [\x1930-\x193b]+ | [\x1946-\x196d]+ | [\x1970-\x1974]+ | [\x1d00-\x1d6b]+ | [\x1e00-\x1e9b]+ | [\x1ea0-\x1ef9]+ | [\x1f00-\x1f15]+ | [\x1f18-\x1f1d]+ | [\x1f20-\x1f45]+ | [\x1f48-\x1f4d]+ | [\x1f50-\x1f57]+ | \x1f59+ | \x1f5b+ | \x1f5d+ | [\x1f5f-\x1f7d]+ | [\x1f80-\x1fb4]+ | [\x1fb6-\x1fbc]+ | \x1fbe+ | [\x1fc2-\x1fc4]+ | [\x1fc6-\x1fcc]+ | [\x1fd0-\x1fd3]+ | [\x1fd6-\x1fdb]+ | [\x1fe0-\x1fec]+ | [\x1ff2-\x1ff4]+ | [\x1ff6-\x1ffc]+ | [\x203f-\x2040]+ | \x2054+ | \x2071+ | \x207f+ | [\x20d0-\x20dc]+ | \x20e1+ | [\x20e5-\x20ea]+ | \x2102+ | \x2107+ | [\x210a-\x2113]+ | \x2115+ | [\x2118-\x211d]+ | \x2124+ | \x2126+ | \x2128+ | [\x212a-\x2131]+ | [\x2133-\x2139]+ | [\x213d-\x213f]+ | [\x2145-\x2149]+ | [\x2160-\x2183]+ | [\x3005-\x3007]+ | [\x3021-\x302f]+ | [\x3031-\x3035]+ | [\x3038-\x303c]+ | [\x3041-\x3096]+ | [\x3099-\x309a]+ | [\x309d-\x309f]+ | [\x30a1-\x30ff]+ | [\x3105-\x312c]+ | [\x3131-\x318e]+ | [\x31a0-\x31b7]+ | [\x31f0-\x31ff]+ | [\x3400-\x4db5]+ | [\x4e00-\x9fa5]+ | [\xa000-\xa48c]+ | [\xac00-\xd7a3]+ | [\xf900-\xfa2d]+ | [\xfa30-\xfa6a]+ | [\xfb00-\xfb06]+ | [\xfb13-\xfb17]+ | [\xfb1d-\xfb28]+ | [\xfb2a-\xfb36]+ | [\xfb38-\xfb3c]+ | \xfb3e+ | [\xfb40-\xfb41]+ | [\xfb43-\xfb44]+ | [\xfb46-\xfbb1]+ | [\xfbd3-\xfc5d]+ | [\xfc64-\xfd3d]+ | [\xfd50-\xfd8f]+ | [\xfd92-\xfdc7]+ | [\xfdf0-\xfdf9]+ | [\xfe00-\xfe0f]+ | [\xfe20-\xfe23]+ | [\xfe33-\xfe34]+ | [\xfe4d-\xfe4f]+ | \xfe71+ | \xfe73+ | \xfe77+ | \xfe79+ | \xfe7b+ | \xfe7d+ | [\xfe7f-\xfefc]+ | [\xff10-\xff19]+ | [\xff21-\xff3a]+ | \xff3f+ | [\xff41-\xff5a]+ | [\xff65-\xffbe]+ | [\xffc2-\xffc7]+ | [\xffca-\xffcf]+ | [\xffd2-\xffd7]+ | [\xffda-\xffdc]+ | \xd800 [\xdc00-\xdc0a]+ | \xd800 [\xdc0d-\xdc25]+ | \xd800 [\xdc28-\xdc39]+ | \xd800 [\xdc3c-\xdc3c]+ | \xd800 [\xdc3f-\xdc4c]+ | \xd800 [\xdc50-\xdc5c]+ | \xd800 [\xdc80-\xdcf9]+ | \xd800 [\xdf00-\xdf1d]+ | \xd800 [\xdf30-\xdf49]+ | \xd800 [\xdf80-\xdf9c]+ | \xd801 [\xe000-\xe09c]+ | \xd801 [\xe0a0-\xe0a8]+ | \xd802 [\xe400-\xe404]+ | \xd802 \x0808+ | \xd802 [\xe40a-\xe434]+ | \xd802 [\xe437-\xe437]+ | \xd802 \x083c+ | \xd802 \x083f+ | \xd834 [\xad65-\xad68]+ | \xd834 [\xad6d-\xad71]+ | \xd834 [\xad7b-\xad81]+ | \xd834 [\xad85-\xad8a]+ | \xd834 [\xadaa-\xadac]+ | \xd835 [\xb000-\xb053]+ | \xd835 [\xb056-\xb09b]+ | \xd835 [\xb09e-\xb09e]+ | \xd835 \xd4a2+ | \xd835 [\xb0a5-\xb0a5]+ | \xd835 [\xb0a9-\xb0ab]+ | \xd835 [\xb0ae-\xb0b8]+ | \xd835 \xd4bb+ | \xd835 [\xb0bd-\xb0c2]+ | \xd835 [\xb0c5-\xb104]+ | \xd835 [\xb107-\xb109]+ | \xd835 [\xb10d-\xb113]+ | \xd835 [\xb116-\xb11b]+ | \xd835 [\xb11e-\xb138]+ | \xd835 [\xb13b-\xb13d]+ | \xd835 [\xb140-\xb143]+ | \xd835 \xd546+ | \xd835 [\xb14a-\xb14f]+ | \xd835 [\xb152-\xb2a2]+ | \xd835 [\xb2a8-\xb2bf]+ | \xd835 [\xb2c2-\xb2d9]+ | \xd835 [\xb2dc-\xb2f9]+ | \xd835 [\xb2fc-\xb313]+ | \xd835 [\xb316-\xb333]+ | \xd835 [\xb336-\xb34d]+ | \xd835 [\xb350-\xb36d]+ | \xd835 [\xb370-\xb387]+ | \xd835 [\xb38a-\xb3a7]+ | \xd835 [\xb3aa-\xb3c1]+ | \xd835 [\xb3c4-\xb3c8]+ | \xd835 [\xb3ce-\xb3fe]+ | \xd840 [\xdc00-\xdffe]+ | \xd841 [\xe000-\xe3fe]+ | \xd842 [\xe400-\xe7fe]+ | \xd843 [\xe800-\xebfe]+ | \xd844 [\xec00-\xeffe]+ | \xd845 [\xf000-\xf3fe]+ | \xd846 [\xf400-\xf7fe]+ | \xd847 [\xf800-\xfbfe]+ | \xd848 [\xfc00-\xfffe]+ | \xd849 [\x0000-\x03fe]+ | \xd84a [\x0400-\x07fe]+ | \xd84b [\x0800-\x0bfe]+ | \xd84c [\x0c00-\x0ffe]+ | \xd84d [\x1000-\x13fe]+ | \xd84e [\x1400-\x17fe]+ | \xd84f [\x1800-\x1bfe]+ | \xd850 [\x1c00-\x1ffe]+ | \xd851 [\x2000-\x23fe]+ | \xd852 [\x2400-\x27fe]+ | \xd853 [\x2800-\x2bfe]+ | \xd854 [\x2c00-\x2ffe]+ | \xd855 [\x3000-\x33fe]+ | \xd856 [\x3400-\x37fe]+ | \xd857 [\x3800-\x3bfe]+ | \xd858 [\x3c00-\x3ffe]+ | \xd859 [\x4000-\x43fe]+ | \xd85a [\x4400-\x47fe]+ | \xd85b [\x4800-\x4bfe]+ | \xd85c [\x4c00-\x4ffe]+ | \xd85d [\x5000-\x53fe]+ | \xd85e [\x5400-\x57fe]+ | \xd85f [\x5800-\x5bfe]+ | \xd860 [\x5c00-\x5ffe]+ | \xd861 [\x6000-\x63fe]+ | \xd862 [\x6400-\x67fe]+ | \xd863 [\x6800-\x6bfe]+ | \xd864 [\x6c00-\x6ffe]+ | \xd865 [\x7000-\x73fe]+ | \xd866 [\x7400-\x77fe]+ | \xd867 [\x7800-\x7bfe]+ | \xd868 [\x7c00-\x7ffe]+ | \xd869 [\x8000-\x82d5]+ | \xd87e [\xd400-\xd61c]+ | \xdb40 [\xdd00-\xddee]++@embedded_exp_open = "${e|"+@embedded_ident_open = "${i|"++@ident = @xid_start @xid_continue*+@raw_ident = r \# @ident++@lifetime = \' @ident++$hexit = [0-9a-fA-F]++@char_escape+ = [nrt\\'"0]+ | [xX] [0-7] $hexit+ | u\{ $hexit \}+ | u\{ $hexit $hexit \}+ | u\{ $hexit $hexit $hexit \}+ | u\{ $hexit $hexit $hexit $hexit \}+ | u\{ $hexit $hexit $hexit $hexit $hexit \}+ | u\{ $hexit $hexit $hexit $hexit $hexit $hexit \}++@byte_escape+ = [xX] $hexit $hexit+ | [nrt\\'"0]++-- literals++@lit_char+ = \' ( \\ @char_escape+ | [^\\'\n\t\r]+ | [ \ud800-\udbff \udc00-\udfff ]+ )+ \'++@lit_byte+ = b\' ( \\ @byte_escape + | [^\\'\n\t\r] [ \udc00-\udfff ]?+ )+ \'++@lit_integer+ = [0-9][0-9_]*+ | 0b [01_]++ | 0o [0-8_]++ | 0x [0-9a-fA-F_]+++@decimal_suffix = \. [0-9][0-9_]*+@exponent_suffix = [eE] [\-\+]? [0-9][0-9_]*++@lit_float = [0-9][0-9_]* @decimal_suffix? @exponent_suffix?+@lit_float2 = [0-9][0-9_]* \.++@lit_str = \" (\\\n | \\\r\n | \\ @char_escape | [^\\\"] | \n | \r)* \"+@lit_byte_str = b \" (\\\n | \\\r\n | \\ @byte_escape | [^\\\"] | \n | \r)* \"++@lit_raw_str = r \#* \"+@lit_raw_bstr = br \#* \"+++-- Comments++@outer_doc_line = "///" ( [^\r\n\/] [^\r\n]* )?+@outer_doc_inline = "/**"++@inner_doc_line = "//!" [^\r\n]*+@inner_doc_inline = "/*!"++@line_comment = "//" ( [^\n\/]* [^\n]* )?+@inline_comment = "/*"++-- Macro related++@subst_nt = "$" @ident++tokens :-++$white+ { \s -> pure (Space Whitespace s) }++"=" { token Equal }+"<" { token Less }+">" { token Greater }+"&" { token Ampersand }+"|" { token Pipe }+"!" { token Exclamation }+"~" { token Tilde }+"+" { token Plus }+"-" { token Minus }+"*" { token Star }+"/" { token Slash }+"%" { token Percent }+"^" { token Caret }++"||" { token PipePipe }+"&&" { token AmpersandAmpersand }+">=" { token GreaterEqual }+">>=" { token GreaterGreaterEqual }+"<<" { token LessLess }+">>" { token GreaterGreater }++"==" { token EqualEqual }+"!=" { token NotEqual }+"<=" { token LessEqual }+"<<=" { token LessLessEqual }+"-=" { token MinusEqual }+"&=" { token AmpersandEqual }+"|=" { token PipeEqual }+"+=" { token PlusEqual }+"*=" { token StarEqual }+"/=" { token SlashEqual }+"^=" { token CaretEqual }+"%=" { token PercentEqual }++@embedded_exp_open { \_ -> mkEmbedExp } -- (EmbeddedCode $ (drop 4 . init . init) s) }+@embedded_ident_open { \_ -> mkEmbedIdent } -- (EmbeddedIdent $ (drop 4 . init . init) s) }+@subst_nt { \s -> pure $ EmbeddedIdent $ tail s }++"@" { token At } +"." { token Dot } +".." { token DotDot } +"..." { token DotDotDot } +"..=" { token DotDotEqual } +"," { token Comma } +";" { token Semicolon } +":" { token Colon }+"::" { token ModSep }+"->" { token RArrow }+"<-" { token LArrow }+"=>" { token FatArrow }+"(" { token (OpenDelim Paren) } +")" { token (CloseDelim Paren) } +"[" { token (OpenDelim Bracket) }+"]" { token (CloseDelim Bracket) }+"{" { token (OpenDelim Brace) } +"}" { token (CloseDelim Brace) } +"#" { token Pound } +"$" { token Dollar } ++@lit_integer { \i -> literal (IntegerTok i) }+@lit_float { \f -> literal (FloatTok f) }+@lit_float2 / ( [^\._a-zA-Z] | \r | \n )+ { \f -> literal (FloatTok f) }+@lit_float2 / { \_ _ _ (_,is) -> inputStreamEmpty is }+ { \f -> literal (FloatTok f) }++@lit_byte { \c -> literal (ByteTok (drop 2 (init c))) }+@lit_char { \c -> literal (CharTok (drop 1 (init c))) }+@lit_str { \s -> literal (StrTok (cleanWindowsNewlines (drop 1 (init s)))) }+@lit_byte_str { \s -> literal (ByteStrTok (cleanWindowsNewlines (drop 2 (init s)))) }++@lit_raw_str { \s -> let n = length s - 2+ in do+ str <- cleanWindowsNewlines `fmap` rawString n+ literal (StrRawTok str (fromIntegral n))+ }+@lit_raw_bstr { \s -> let n = length s - 3+ in do+ str <- cleanWindowsNewlines `fmap` rawString n+ literal (ByteStrRawTok str (fromIntegral n))+ }++<lits> "" ;+<lits> @ident { \s -> pure (IdentTok (mkIdent s)) }++\? { token Question }+@raw_ident { \s -> pure (IdentTok ((mkIdent (drop 2 s)){ raw = True })) } +@ident { \s -> pure (IdentTok (mkIdent s)) } +@lifetime { \s -> (pure (LifetimeTok (mkIdent (tail s))) :: P Token) }+++@outer_doc_line { \c -> pure (Doc (drop 3 c) Outer False) } +@outer_doc_line \r { \c -> pure (Doc (drop 3 (init c)) Outer False) } +@outer_doc_inline / ( [^\*] | \r | \n )+ { \_ -> Doc <$> nestedComment <*> pure Outer <*> pure True }++@inner_doc_line { \c -> pure (Doc (drop 3 c) Inner False) }+@inner_doc_inline { \_ -> Doc <$> nestedComment <*> pure Inner <*> pure True }++@line_comment { \c -> pure (Space Comment (drop 2 c)) }+@inline_comment { \_ -> Space Comment <$> nestedComment }++{++nextEmbedChar :: P Char+nextEmbedChar = do+ c <- nextChar+ case c of+ Nothing -> fail "Unclosed embedded expression."+ Just c' -> pure c'++mkEmbedIt :: P String+mkEmbedIt = do+ c0 <- nextEmbedChar+ (case c0 of+ '|' -> do+ c1 <- nextEmbedChar+ (case c1 of+ '}' -> pure ""+ _ -> ([c0,c1] ++) <$> mkEmbedIt)+ _ -> (c0 :) <$> mkEmbedIt)++mkEmbedExp :: P Token+mkEmbedExp = EmbeddedCode <$> mkEmbedIt -- EmbeddedCode $ (drop 4 . init . init) s)++mkEmbedIdent :: P Token+mkEmbedIdent = EmbeddedIdent <$> mkEmbedIt -- (EmbeddedIdent $ (drop 4 . init . init) s)++-- | Make a token.+token :: Token -> String -> P Token+token t _ = pure t++-- | Given the first part of a literal, try to parse also a suffix. Even if+-- the allowed suffixes are very well defined and only valid on integer and+-- float literals, we need to put in the same token whatever suffix follows.+-- This is for backwards compatibility if Rust decides to ever add suffixes. +literal :: LitTok -> P Token +literal lit = do+ pos <- getPosition+ inp <- getInput+ case alexScan (pos,inp) lits of+ AlexToken (pos',inp') len action -> do+ tok <- action (peekChars len inp)+ case tok of+ IdentTok (Ident (Name suf) False _) -> do+ setPosition pos'+ setInput inp'+ pure (LiteralTok lit (Just suf))+ _ -> pure (LiteralTok lit Nothing)+ _ -> pure (LiteralTok lit Nothing)++-- | Parses a raw string, the closing quotation, and the appropriate number of+-- '#' characters.+rawString :: Int -> P String+rawString n = do+ c_m <- nextChar+ case c_m of+ -- The string was never closed+ Nothing -> fail "Invalid raw (byte)string"+ + -- The string has a chance of being closed+ Just '"' -> do+ n' <- greedyChar '#' n+ if n' == n+ then pure ""+ else (('"' : replicate n' '#') ++) <$> rawString n ++ -- Just another character...+ Just c -> ([c] ++) <$> rawString n ++-- | Consume a full inline comment (which may be nested).+nestedComment :: P String+nestedComment = go 1 ""+ where+ go :: Int -> String -> P String+ go 0 s = pure (reverse (drop 2 s))+ go n s = do+ c <- nextChar+ case c of+ Nothing -> fail "Unclosed comment"+ Just '*' -> do+ c' <- peekChar+ case c' of + Nothing -> fail "Unclosed comment"+ Just '/' -> nextChar *> go (n-1) ('/':'*':s)+ Just _ -> go n ('*':s)+ Just '/' -> do+ c' <- peekChar+ case c' of + Nothing -> fail "Unclosed comment"+ Just '*' -> nextChar *> go (n+1) ('*':'/':s) + Just _ -> go n ('/':s)+ Just c' -> go n (c':s)+++-- Monadic functions++-- | Retrieve the next character (if there is one), updating the parser state accordingly.+nextChar :: P (Maybe Char)+nextChar = do+ pos <- getPosition+ inp <- getInput+ if inputStreamEmpty inp + then pure Nothing+ else let (c,inp') = takeChar inp+ pos' = alexMove pos c+ in pos' `seq` (setPosition pos' *> setInput inp' *> pure (Just c))++-- | Retrieve the next character (if there is one), without updating the+-- parser state.+peekChar :: P (Maybe Char)+peekChar = do+ inp <- getInput+ if inputStreamEmpty inp + then pure Nothing+ else let (c,_) = takeChar inp+ in pure (Just c)++-- | Greedily try to eat as many of a given character as possible (and return+-- how many characters were eaten). The second argument is an upper limit.+greedyChar :: Char -> Int -> P Int+greedyChar _ 0 = pure 0+greedyChar c limit = do+ c_m <- peekChar+ case c_m of+ Just c' | c == c' -> do { _ <- nextChar; n <- greedyChar c (limit - 1); pure (n+1) }+ _ -> pure 0++-- | Signal a lexical error.+lexicalError :: P a+lexicalError = do+ c <- peekChar+ fail ("Lexical error: the character " ++ show c ++ " does not fit here")+++-- Functions required by Alex ++-- | type passed around by Alex functions (required by Alex)+type AlexInput = (Position, -- current position,+ InputStream) -- current input string++-- | get previous character (required by Alex). Since this is never used, the+-- implementation just raises an error.+alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar _ = error "alexInputPrevChar not used"++-- | get the next byte and new input from the current input (required by Alex+-- 3.0)+alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)+alexGetByte (pos,inp)+ | inputStreamEmpty inp = Nothing+ | otherwise = let (b,inp') = takeByte inp+ -- this is safe for latin-1, but ugly+ pos' = alexMove pos (chr (fromIntegral b))+ in pos' `seq` Just (b, (pos', inp'))++-- | find the new position given the next character+alexMove :: Position -> Char -> Position+alexMove pos ' ' = incPos pos 1+alexMove pos '\n' = retPos pos+alexMove pos '\r' = incOffset pos 1+alexMove pos _ = incPos pos 1++-- | Lexer for one 'Token'. The only token this cannot produce is 'Interpolated'. +lexToken :: P (Spanned Token)+lexToken = do+ tok_maybe <- popToken+ case tok_maybe of+ Just tok -> pure tok+ Nothing -> do+ pos <- getPosition+ inp <- getInput+ case alexScan (pos, inp) 0 of+ AlexEOF -> pure (Spanned Eof (Span pos pos))+ AlexError _ -> fail "lexical error"+ AlexSkip (pos',inp') _ -> setPosition pos' *> setInput inp' *> lexToken+ AlexToken (pos',inp') len action -> do+ setPosition pos'+ setInput inp'+ tok <- action (peekChars len inp)+ tok' <- swapToken tok+ pos'' <- getPosition+ return (Spanned tok' (Span pos pos''))++-- | Lexer for one non-whitespace 'Token'. The only tokens this cannot produce are 'Interpolated'+-- and 'Space' (which includes comments that aren't doc comments).+lexNonSpace :: P (Spanned Token)+lexNonSpace = do+ tok <- lexToken+ case tok of+ Spanned Space{} _ -> lexNonSpace+ _ -> pure tok++-- | Apply the given lexer repeatedly until (but not including) the 'Eof' token. Meant for debugging+-- purposes - in general this defeats the point of a threaded lexer.+lexTokens :: P (Spanned Token) -> P [Spanned Token]+lexTokens lexer = do+ tok <- lexer+ case tok of+ Spanned Eof _ -> pure []+ _ -> (tok :) <$> lexTokens lexer++-- | Lex the first line, if it immediately starts with @#!@ (but not @#![@ - that should be an+-- inner attribute). If this fails to find a shebang line, it consumes no input.+lexShebangLine :: P (Maybe String)+lexShebangLine = do+ inp <- getInput+ case peekChars 3 inp of+ '#':'!':r | r /= "[" -> Just <$> toNewline+ _ -> pure Nothing+ where+ -- Lexes a string until a newline+ toNewline :: P String+ toNewline = do+ c <- peekChar+ case c of+ Nothing -> pure ""+ Just '\n' -> pure ""+ Just c' -> do+ _ <- nextChar+ (c' :) <$> toNewline++-- | If we're running on Windows, we need to normalize to "\n" instead of "\r\n", to match Rust's+-- handling of newlines in strings.+cleanWindowsNewlines :: String -> String+cleanWindowsNewlines "" = ""+cleanWindowsNewlines ('\r':'\n':rest) = '\n' : cleanWindowsNewlines rest+cleanWindowsNewlines (x:rest) = x : cleanWindowsNewlines rest+}
+ src/Language/Rust/Parser/Literals.hs view
@@ -0,0 +1,130 @@+{-|+Module : Language.Rust.Parser.Literals+Description : Parsing literals+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++Functions for parsing literals from valid literal tokens. Note the functions in this module fail+badly is fed invalid 'LitTok's; it is expected their input is coming from Alex and is correct.+-}++module Language.Rust.Parser.Literals (+ translateLit+) where++import Language.Rust.Syntax.Token ( LitTok(..) )+import Language.Rust.Syntax.AST ( IntRep(..), Lit(..), StrStyle(..), Suffix(..) )++import Data.Char ( chr, digitToInt, ord, isHexDigit, isSpace )+import Data.List ( unfoldr )+import Data.Maybe ( fromMaybe )+import Data.Word ( Word8 )++import Text.Read ( readMaybe )++-- | Parse a valid 'LitTok' into a 'Lit'.+translateLit :: LitTok -> Suffix -> a -> Lit a+translateLit (ByteTok s) = Byte (unescapeByte' s)+translateLit (CharTok s) = Char (unescapeChar' s)+translateLit (FloatTok s) = Float (unescapeFloat s)+translateLit (StrTok s) = Str (unfoldr (unescapeChar True) s) Cooked+translateLit (StrRawTok s n) = Str s (Raw n)+translateLit (ByteStrTok s) = ByteStr (unfoldr (unescapeByte True) s) Cooked+translateLit (ByteStrRawTok s n) = ByteStr (map (fromIntegral . ord) s) (Raw n)+translateLit (IntegerTok s) = \suf -> case (suf, unescapeInteger s) of+ (F32, (Dec, n)) -> Float (fromInteger n) F32+ (F64, (Dec, n)) -> Float (fromInteger n) F64+ (_, (rep, n)) -> Int rep n s suf++-- | Given a string of characters read from a Rust source, extract the next underlying char taking+-- into account escapes and unicode.+unescapeChar :: Bool -- ^ multi-line strings allowed+ -> String -- ^ input string+ -> Maybe (Char, String)+unescapeChar multiline ('\\':c:cs) = case c of+ 'n' -> pure ('\n', cs)+ 'r' -> pure ('\r', cs)+ 't' -> pure ('\t', cs)+ '\\' -> pure ('\\', cs)+ '\'' -> pure ('\'', cs)+ '"' -> pure ('"', cs)+ '0' -> pure ('\0', cs)+ 'x' -> do (h,cs') <- readHex 2 cs; pure (chr h, cs')+ 'X' -> do (h,cs') <- readHex 2 cs; pure (chr h, cs')+ 'U' -> do (h,cs') <- readHex 8 cs; pure (chr h, cs')+ 'u' -> case cs of+ '{':x1:'}':cs' -> do (h,_) <- readHex 1 [x1]; pure (chr h, cs')+ '{':x1:x2:'}':cs' -> do (h,_) <- readHex 2 [x1,x2]; pure (chr h, cs')+ '{':x1:x2:x3:'}':cs' -> do (h,_) <- readHex 3 [x1,x2,x3]; pure (chr h, cs')+ '{':x1:x2:x3:x4:'}':cs' -> do (h,_) <- readHex 4 [x1,x2,x3,x4]; pure (chr h, cs')+ '{':x1:x2:x3:x4:x5:'}':cs' -> do (h,_) <- readHex 5 [x1,x2,x3,x4,x5]; pure (chr h, cs')+ '{':x1:x2:x3:x4:x5:x6:'}':cs' -> do (h,_) <- readHex 6 [x1,x2,x3,x4,x5,x6]; pure (chr h, cs')+ _ -> do (h,cs') <- readHex 4 cs; pure (chr h, cs')+ '\n' | multiline -> unescapeChar multiline $ dropWhile isSpace cs+ _ -> error "unescape char: bad escape sequence"+unescapeChar _ (c:cs) = Just (c, cs)+unescapeChar _ [] = fail "unescape char: empty string"++-- | Given a string of characters read from a Rust source, extract the next underlying byte taking+-- into account escapes.+unescapeByte :: Bool -- ^ multi-line strings allowed+ -> String -- ^ input string+ -> Maybe (Word8, String)+unescapeByte multiline ('\\':c:cs) = case c of+ 'n' -> pure (toEnum $ fromEnum '\n', cs)+ 'r' -> pure (toEnum $ fromEnum '\r', cs)+ 't' -> pure (toEnum $ fromEnum '\t', cs)+ '\\' -> pure (toEnum $ fromEnum '\\', cs)+ '\'' -> pure (toEnum $ fromEnum '\'', cs)+ '"' -> pure (toEnum $ fromEnum '"', cs)+ '0' -> pure (toEnum $ fromEnum '\0', cs)+ 'x' -> do (h,cs') <- readHex 2 cs; pure (h, cs')+ 'X' -> do (h,cs') <- readHex 2 cs; pure (h, cs')+ '\n' | multiline -> unescapeByte multiline $ dropWhile isSpace cs+ _ -> error "unescape byte: bad escape sequence"+unescapeByte _ (c:cs) = Just (toEnum $ fromEnum c, cs)+unescapeByte _ [] = fail "unescape byte: empty string"++-- | Given a string Rust representation of a character, parse it into a character+unescapeChar' :: String -> Char+unescapeChar' s = case unescapeChar False s of+ Just (c, "") -> c+ _ -> error "unescape char: bad character literal"++-- | Given a string Rust representation of a byte, parse it into a byte+unescapeByte' :: String -> Word8+unescapeByte' s = case unescapeByte False s of+ Just (w8, "") -> w8+ _ -> error "unescape byte: bad byte literal"++-- | Given a string Rust representation of an integer, parse it into a number+unescapeInteger :: Num a => String -> (IntRep,a)+unescapeInteger ('0':'b':cs@(_:_)) | all (`elem` "_01") cs = (Bin, numBase 2 (filter (/= '_') cs))+unescapeInteger ('0':'o':cs@(_:_)) | all (`elem` "_01234567") cs = (Oct, numBase 8 (filter (/= '_') cs))+unescapeInteger ('0':'x':cs@(_:_)) | all (`elem` "_0123456789abcdefABCDEF") cs = (Hex, numBase 16 (filter (/= '_') cs))+unescapeInteger cs@(_:_) | all (`elem` "_0123456789") cs = (Dec, numBase 10 (filter (/= '_') cs))+unescapeInteger _ = error "unescape integer: bad decimal literal"++-- | Given a string Rust representation of a float, parse it into a float.+-- NOTE: this is a bit hacky. Eventually, we might not do this and change the internal+-- representation of a float to a string (what language-c has opted to do).+unescapeFloat :: String -> Double+unescapeFloat cs = fromMaybe (error $ "unescape float: cannot parse float " ++ cs') (readMaybe cs')+ where cs' = filter (/= '_') (if last cs == '.' then cs ++ "0" else cs)++-- | Try to read a hexadecimal number of the specified length off of the front of the string+-- provided. If there are not enough characters to do this, or the characters don't fall in the+-- right range, this fails with 'Nothing'.+readHex :: Num a => Int -> String -> Maybe (a, String)+readHex n cs = let digits = take n cs+ in if length digits == n && all isHexDigit digits+ then Just (numBase 16 digits, drop n cs)+ else Nothing++-- | Convert a list of characters to the number they represent.+numBase :: Num a => a -> String -> a+numBase b = foldl (\n x -> fromIntegral (digitToInt x) + b * n) 0+
+ src/Language/Rust/Parser/NonEmpty.hs view
@@ -0,0 +1,80 @@+{-|+Module : Language.Rust.Parser.NonEmpty+Description : Non-empty lists+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++Datatype wrapping non-empty lists.+-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+#if __GLASGOW_HASKELL__ < 800+{-# LANGUAGE FlexibleContexts #-}+#endif+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell, DeriveFoldable, DeriveFunctor, GeneralizedNewtypeDeriving, DeriveTraversable #-}++module Language.Rust.Parser.NonEmpty (+ NonEmpty(..),+ listCons,+ head, tail,+ reverse, last, init, (<|), (|:), (|>)+) where+import Prelude hiding (head, tail, reverse, init, last)++import qualified Data.List.NonEmpty as N+import Data.Data ( Data(..) )+import Control.DeepSeq ( NFData )+import Data.Semigroup (Semigroup(..))++-- Support for OverloadedLists of NonEmpty lists:+import GHC.Exts (IsList(..))++newtype NonEmpty a = NonEmpty (N.NonEmpty a)+ deriving (Foldable, Eq, Ord, Show, Functor, Data, NFData, Traversable)++instance IsList (NonEmpty a) where+ type Item (NonEmpty a) = a++ fromList (a:as) = NonEmpty $ a N.:| as+ fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"++ toList ~(NonEmpty (a N.:| as)) = a : as++instance Semigroup (NonEmpty a) where+ (NonEmpty (a N.:| as)) <> ~(NonEmpty (b N.:| bs)) = NonEmpty $ a N.:| (as ++ b : bs)++listCons :: a -> [a] -> NonEmpty a+listCons a as = NonEmpty $ a N.:| as++head :: NonEmpty a -> a+head (NonEmpty as) = N.head as++tail :: NonEmpty a -> [a]+tail (NonEmpty as) = N.tail as++reverse :: NonEmpty a -> NonEmpty a+reverse (NonEmpty as) = NonEmpty $ N.reverse as++init :: NonEmpty a -> [a]+init (NonEmpty as) = N.init as++last :: NonEmpty a -> a+last (NonEmpty as) = N.last as++(<|) :: a -> NonEmpty a -> NonEmpty a+(<|) a (NonEmpty as) = NonEmpty $ a N.<| as++(|:) :: [a] -> a -> NonEmpty a+[] |: y = NonEmpty $ y N.:| []+(x:xs) |: y = NonEmpty $ x N.:| (xs ++ [y])++(|>) :: NonEmpty a -> a -> NonEmpty a+(|>) (NonEmpty (x N.:| xs)) y = NonEmpty $ x N.:| (xs ++ [y])+
+ src/Language/Rust/Parser/ParseMonad.hs view
@@ -0,0 +1,170 @@+{-|+Module : Language.Rust.Parser.ParseMonad+Description : Parsing monad for lexer/parser+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++Both the lexer and the parser run inside of the 'P' monad. As detailed in the section on +on [threaded-lexers](https://www.haskell.org/happy/doc/html/sec-monads.html#sec-lexers) in Happy's+instruction manual, the benefits of this are that:++ * Lexical errors can be treated in the same way as parse errors+ * Information such as the current position in the file shared between the lexer and parser+ * General information can be passed back from the parser to the lexer too++In our case, this shared information is held in 'PState'.+-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Language.Rust.Parser.ParseMonad (+ -- * Parsing monad+ P,+ execParser,+ execParser',+ initPos,+ PState(..),++ -- * Monadic operations+ getPState,+ setPState,+ getPosition,+ setPosition,+ getInput,+ setInput,+ popToken,+ pushToken,+ swapToken,++ -- * Error reporting+ ParseFail(..),+ parseError,+) where++import Language.Rust.Data.InputStream ( InputStream )+import Language.Rust.Data.Position ( Spanned, Position, initPos, prettyPosition )+import Language.Rust.Syntax.Token ( Token )++import Control.Monad.Fail as Fail+import Control.Exception ( Exception )+import Data.Maybe ( listToMaybe )+import Data.Typeable ( Typeable )++-- | Parsing and lexing monad. A value of type @'P' a@ represents a parser that can be run (using+-- 'execParser') to possibly produce a value of type @a@.+newtype P a = P { unParser :: forall r. PState -- State being passed along+ -> (a -> PState -> r) -- Successful parse continuation+ -> (String -> Position -> r) -- Failed parse continuation+ -> r -- Final output+ }++-- | State that the lexer and parser share+data PState = PState+ { curPos :: !Position -- ^ position at current input location+ , curInput :: !InputStream -- ^ the current input+ , prevPos :: Position -- ^ position at previous input location+ , pushedTokens :: [Spanned Token] -- ^ tokens manually pushed by the user+ , swapFunction :: Token -> Token -- ^ function to swap token+ }++instance Functor P where+ fmap f m = P $ \ !s pOk pFailed -> unParser m s (pOk . f) pFailed++instance Applicative P where+ pure x = P $ \ !s pOk _ -> pOk x s++ m <*> k = P $ \ !s pOk pFailed ->+ let pOk' x s' = unParser k s' (pOk . x) pFailed+ in unParser m s pOk' pFailed++instance Monad P where+ return = pure++ m >>= k = P $ \ !s pOk pFailed ->+ let pOk' x s' = unParser (k x) s' pOk pFailed+ in unParser m s pOk' pFailed++instance Fail.MonadFail P where+ fail msg = P $ \ !s _ pFailed -> pFailed msg (curPos s)++-- | Exceptions that occur during parsing+data ParseFail = ParseFail Position String deriving (Eq, Typeable)++instance Show ParseFail where+ showsPrec p (ParseFail pos msg) = showParen (p >= 11) (showString err)+ where err = unwords [ "parse failure at", prettyPosition pos, "(" ++ msg ++ ")" ]++instance Exception ParseFail++-- | Execute the given parser on the supplied input stream at the given start position, returning+-- either the position of an error and the error message, or the value parsed.+execParser :: P a -> InputStream -> Position -> Either ParseFail a+execParser p input pos = execParser' p input pos id++-- | Generalized version of 'execParser' that expects an extra argument that lets you hot-swap a+-- token that was just lexed before it gets passed to the parser.+execParser' :: P a -> InputStream -> Position -> (Token -> Token) -> Either ParseFail a+execParser' parser input pos swap = unParser parser+ initialState+ (\result _ -> Right result)+ (\message errPos -> Left (ParseFail errPos message))+ where initialState = PState+ { curPos = pos+ , curInput = input+ , prevPos = error "ParseMonad.execParser: Touched undefined position!"+ , pushedTokens = []+ , swapFunction = swap+ }++-- | Swap a token using the swap function.+swapToken :: Token -> P Token+swapToken t = P $ \ !s@PState{ swapFunction = f } pOk _ -> pOk (f $! t) s++-- | Extract the state stored in the parser.+getPState :: P PState+getPState = P $ \ !s pOk _ -> pOk s s ++-- | Update the state stored in the parser.+setPState :: PState -> P ()+setPState s = P $ \ _ pOk _ -> pOk () s ++-- | Modify the state stored in the parser.+modifyPState :: (PState -> PState) -> P ()+modifyPState f = P $ \ !s pOk _ -> pOk () (f $! s) ++-- | Retrieve the current position of the parser.+getPosition :: P Position+getPosition = curPos <$> getPState++-- | Update the current position of the parser.+setPosition :: Position -> P ()+setPosition pos = modifyPState $ \ s -> s{ curPos = pos }++-- | Retrieve the current 'InputStream' of the parser.+getInput :: P InputStream+getInput = curInput <$> getPState ++-- | Update the current 'InputStream' of the parser.+setInput :: InputStream -> P ()+setInput i = modifyPState $ \s -> s{ curInput = i }++-- | Manually push a @'Spanned' 'Token'@. This turns out to be useful when parsing tokens that need+-- to be broken up. For example, when seeing a 'Language.Rust.Syntax.GreaterEqual' token but only+-- expecting a 'Language.Rust.Syntax.Greater' token, one can consume the+-- 'Language.Rust.Syntax.GreaterEqual' token and push back an 'Language.Rust.Syntax.Equal' token.+pushToken :: Spanned Token -> P ()+pushToken tok = modifyPState $ \s@PState{ pushedTokens = toks } -> s{ pushedTokens = tok : toks }++-- | Manually pop a @'Spanned' 'Token'@ (if there are no tokens to pop, returns 'Nothing'). See+-- 'pushToken' for more details.+popToken :: P (Maybe (Spanned Token))+popToken = P $ \ !s@PState{ pushedTokens = toks } pOk _ -> pOk (listToMaybe toks) s{ pushedTokens = drop 1 toks }++-- | Signal a syntax error.+parseError :: Show b => b -> P a+parseError b = Fail.fail ("Syntax error: the symbol `" ++ show b ++ "' does not fit here")+
+ src/Language/Rust/Parser/Reversed.hs view
@@ -0,0 +1,86 @@+{-|+Module : Language.Rust.Parser.Reversed+Description : Parsing literals+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++Datatypes wrapping lists and non-empty lists designed for fast append (as opposed to prepend) +along with the usual class instances.+-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+#if __GLASGOW_HASKELL__ < 800+{-# LANGUAGE FlexibleContexts #-}+#endif+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Language.Rust.Parser.Reversed (+ Reversed(..),+ toNonEmpty,+ unsnoc,+ snoc,+ NonEmpty(..),+) where++import Language.Rust.Data.Position++import Data.Foldable ( Foldable(toList) )+import Data.Semigroup as Sem ( Semigroup(..) )++import qualified Language.Rust.Parser.NonEmpty as N+import Language.Rust.Parser.NonEmpty (NonEmpty(..), listCons)+import qualified GHC.Exts as G++import Data.Data (Data(..), Typeable)++-- | Wrap a data type where all the operations are reversed+newtype Reversed f a = Reversed (f a)++instance Functor f => Functor (Reversed f) where+ fmap f (Reversed xs) = Reversed (fmap f xs)++instance Foldable (Reversed []) where+ foldMap f (Reversed xs) = foldMap f (reverse xs)+ toList (Reversed xs) = reverse xs++instance Foldable (Reversed NonEmpty) where+ foldMap f (Reversed xs) = foldMap f (N.reverse xs)+ toList (Reversed xs) = reverse (toList xs)++instance Sem.Semigroup (f a) => Sem.Semigroup (Reversed f a) where+ Reversed xs <> Reversed ys = Reversed (ys Sem.<> xs)++instance Monoid (f a) => Monoid (Reversed f a) where+ mempty = Reversed mempty+ mappend (Reversed xs) (Reversed ys) = Reversed (mappend ys xs)++instance G.IsList (f a) => G.IsList (Reversed f a) where+ type Item (Reversed f a) = G.Item (f a)+ fromList xs = Reversed (G.fromList (reverse xs))+ toList (Reversed xs) = reverse (G.toList xs)++instance Located (f a) => Located (Reversed f a) where+ spanOf (Reversed xs) = spanOf xs++deriving instance (Typeable f, Typeable a, Data (f a)) => Data (Reversed f a)++-- | Convert a reversed 'NonEmpty' back into a normal one.+{-# INLINE toNonEmpty #-}+toNonEmpty :: Reversed NonEmpty a -> NonEmpty a+toNonEmpty (Reversed xs) = N.reverse xs++-- | Remove an element from the end of a non-empty reversed sequence+{-# INLINE unsnoc #-}+unsnoc :: Reversed NonEmpty a -> (Reversed [] a, a)+unsnoc (Reversed xs) = (Reversed $ N.tail xs, N.head xs)++-- | Add an element to the end of a reversed sequence to produce a non-empty+-- reversed sequence+{-# INLINE snoc #-}+snoc :: Reversed [] a -> a -> Reversed NonEmpty a+snoc (Reversed xs) x = Reversed (x `listCons` xs)
+ src/Language/Rust/Pretty.hs view
@@ -0,0 +1,238 @@+{-|+Module : Language.Rust.Pretty+Description : Pretty printing+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++This module provides functions for turning ASTs into values of type 'Doc'. These values can then be+rendered into concrete string types using functions from the @prettyprinter@ package. This has some+advantages over printing plain old strings:++ * /Backend independent/: you can use a variety of existing backends to efficiently render to all+ sorts of formats like 'Data.Text.Text', 'String', HTML, and terminal.++ * /Dynamic layouts/: the AST will render differently depending on the desired page width ++ >>> :set -XTypeApplications -XOverloadedStrings+ >>> import Language.Rust.Parser+ >>> import Data.Text.Prettyprint.Doc.Util ( putDocW )+ >>> let src = parse' @(SourceFile Span) "fn foo(x: i32, y: i32, z: i32) -> i32 { x - y + z }"+ >>> let doc = pretty' src <> "\n"+ >>> putDocW 80 doc+ fn foo(x: i32, y: i32, z: i32) -> i32 {+ x - y + z+ }+ >>> putDocW 10 doc+ fn foo(+ x: i32,+ y: i32,+ z: i32,+ ) -> i32 {+ x - y + z+ }++ * /Annotations/: Depending on the backend you are using to render the 'Doc', annotations can+ determine colours, styling, links, etc.++The examples below assume the following GHCi flag and import:++>>> :set -XOverloadedStrings+>>> import Language.Rust.Syntax.AST++-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}++module Language.Rust.Pretty (+ -- * Printing+ pretty,+ pretty',+ prettyAnnotated,+ prettyAnnotated',+ writeSourceFile,+ writeTokens,+ Pretty(..),+ PrettyAnnotated(..),+ Doc,+ + -- * Resolving+ Resolve(..),++ -- * Error reporting+ ResolveFail(..),+ Issue(..),+ Severity(..),+) where++import Language.Rust.Data.Ident+import Language.Rust.Data.Position++import Language.Rust.Syntax.AST+import Language.Rust.Syntax.Token++import Language.Rust.Pretty.Internal+import Language.Rust.Pretty.Resolve++import System.IO ( Handle )+import Data.Typeable ( Typeable )+import Data.Text.Prettyprint.Doc.Render.Text ( renderIO )+import Data.Text.Prettyprint.Doc ( Doc )+import qualified Data.Text.Prettyprint.Doc as PP++import Control.Exception ( throw )++-- | Resolve (see the 'Resolve' typeclass) and pretty print something.+--+-- >>> let one = Lit [] (Int Dec 1 Unsuffixed ()) ()+-- >>> let two = Lit [] (Int Dec 2 Unsuffixed ()) ()+-- >>> let three = Lit [] (Int Dec 3 Unsuffixed ()) ()+-- >>> let bogusVar = PathExpr [] Nothing (Path False [PathSegment "let" Nothing ()] ()) ()+-- >>> pretty (Binary [] MulOp (Binary [] AddOp one two ()) three ())+-- Right (1 + 2) * 3+-- >>> pretty (Binary [] AddOp one bogusVar ())+-- Left (invalid AST (identifier `let' is a keyword))+-- +pretty :: (Resolve a, Pretty a) => a -> Either ResolveFail (Doc b)+pretty = fmap prettyUnresolved . resolve++-- | Same as 'pretty', but throws a 'ResolveFail' exception on invalid ASTs. This function is+-- intended for situations in which you are already stuck catching exceptions - otherwise you should+-- prefer 'pretty'.+--+-- >>> let one = Lit [] (Int Dec 1 Unsuffixed ()) ()+-- >>> let two = Lit [] (Int Dec 2 Unsuffixed ()) ()+-- >>> let three = Lit [] (Int Dec 3 Unsuffixed ()) ()+-- >>> let bogusVar = PathExpr [] Nothing (Path False [PathSegment "let" Nothing ()] ()) ()+-- >>> pretty' (Binary [] MulOp (Binary [] AddOp one two ()) three ())+-- (1 + 2) * 3+-- >>> pretty' (Binary [] AddOp one bogusVar ())+-- *** Exception: invalid AST (identifier `let' is a keyword))+--+pretty' :: (Resolve a, Pretty a) => a -> Doc b+pretty' = either throw id . pretty++-- | Resolve (see the 'Resolve' typeclass) and pretty print something with annotations. Read more+-- about annotations in "Data.Text.Prettyprint.Doc".+--+-- prop> fmap Data.Text.Prettyprint.Doc.noAnnotate . prettyAnnotated = pretty+--+prettyAnnotated :: (Resolve (f a), PrettyAnnotated f) => f a -> Either ResolveFail (Doc a)+prettyAnnotated = fmap prettyAnnUnresolved . resolve++-- | Same as 'prettyAnnotated', but throws a 'ResolveFail' exception on invalid ASTs. This function+-- is intended for situations in which you are already stuck catching exceptions - otherwise you+-- should prefer 'prettyAnnotated'.+--+-- prop> Data.Text.Prettyprint.Doc.noAnnotate . prettyAnnotated' = pretty'+--+prettyAnnotated' :: (Resolve (f a), PrettyAnnotated f) => f a -> Doc a+prettyAnnotated' = either throw id . prettyAnnotated++-- | Given a handle to a file, write a 'SourceFile' in with a desired width of 100 characters.+writeSourceFile :: (Monoid a, Typeable a) => Handle -> SourceFile a -> IO ()+writeSourceFile hdl = renderIO hdl . PP.layoutPretty layout . prettyAnnotated'+ where layout = PP.LayoutOptions (PP.AvailablePerLine 100 1.0)++-- | Given a handle to a file, write a 'SourceFile' in with a desired width of 100 characters.+--+-- The 'Span' associated with the tokens (if present) will be used as a hint for laying out and+-- spacing the tokens.+writeTokens :: Handle -> [Spanned Token] -> IO ()+writeTokens hdl = renderIO hdl . PP.layoutPretty layout . pretty' . Stream . map mkTT+ where layout = PP.LayoutOptions (PP.AvailablePerLine 100 1.0)+ mkTT (Spanned s t) = Tree (Token t s)++-- | Describes things that can be pretty printed.+class Pretty a where+ -- | Pretty print the given value without resolving it.+ prettyUnresolved :: a -> Doc b++instance Pretty Abi where prettyUnresolved = printAbi+instance Pretty BindingMode where prettyUnresolved = printBindingMode+instance Pretty BinOp where prettyUnresolved = printBinOp+instance Pretty Ident where prettyUnresolved = printIdent+instance Pretty ImplPolarity where prettyUnresolved = printPolarity+instance Pretty Suffix where prettyUnresolved = printLitSuffix+instance Pretty LitTok where prettyUnresolved = printLitTok+instance Pretty Mutability where prettyUnresolved = printMutability+instance Pretty RangeLimits where prettyUnresolved = printRangeLimits+instance Pretty Token where prettyUnresolved = printToken+instance Pretty TokenTree where prettyUnresolved = printTt+instance Pretty TokenStream where prettyUnresolved = printTokenStream+instance Pretty UnOp where prettyUnresolved = printUnOp+instance Pretty Unsafety where prettyUnresolved = printUnsafety+instance Pretty (Attribute a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Block a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (SourceFile a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Expr a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Field a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (FieldPat a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (FnDecl a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (ForeignItem a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Generics a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (ImplItem a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Item a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Lifetime a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (LifetimeDef a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Lit a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Mac a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Nonterminal a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Pat a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Path a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (PolyTraitRef a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Stmt a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (StructField a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (TraitItem a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (TraitRef a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Ty a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (TyParam a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (TyParamBound a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Variant a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (UseTree a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (Visibility a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (WhereClause a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty (WherePredicate a) where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved+instance Pretty Position where prettyUnresolved = PP.pretty . prettyPosition+instance Pretty Span where prettyUnresolved = PP.pretty . prettySpan++-- | Similar to 'Pretty', but for types which are parametrized over an annotation type.+class PrettyAnnotated p where+ -- | Pretty print the given value without resolving it, adding annotations in the 'Doc' whenever+ -- possible.+ prettyAnnUnresolved :: p a -> Doc a++-- | This instance prints attributes inline+instance PrettyAnnotated Attribute where prettyAnnUnresolved = flip printAttr True+instance PrettyAnnotated Block where prettyAnnUnresolved = printBlock+instance PrettyAnnotated SourceFile where prettyAnnUnresolved = printSourceFile+instance PrettyAnnotated Expr where prettyAnnUnresolved = printExpr+instance PrettyAnnotated Field where prettyAnnUnresolved = printField+instance PrettyAnnotated FieldPat where prettyAnnUnresolved = printFieldPat+instance PrettyAnnotated FnDecl where prettyAnnUnresolved = printFnArgsAndRet+instance PrettyAnnotated ForeignItem where prettyAnnUnresolved = printForeignItem+instance PrettyAnnotated Generics where prettyAnnUnresolved = printGenerics+instance PrettyAnnotated ImplItem where prettyAnnUnresolved = printImplItem+instance PrettyAnnotated Item where prettyAnnUnresolved = printItem+instance PrettyAnnotated Lifetime where prettyAnnUnresolved = printLifetime+instance PrettyAnnotated LifetimeDef where prettyAnnUnresolved = printLifetimeDef+instance PrettyAnnotated Lit where prettyAnnUnresolved = printLit+instance PrettyAnnotated Mac where prettyAnnUnresolved = printMac Paren+instance PrettyAnnotated Nonterminal where prettyAnnUnresolved = printNonterminal+instance PrettyAnnotated Pat where prettyAnnUnresolved = printPat+instance PrettyAnnotated Path where prettyAnnUnresolved = flip printPath False+instance PrettyAnnotated PolyTraitRef where prettyAnnUnresolved = printPolyTraitRef+instance PrettyAnnotated Stmt where prettyAnnUnresolved = printStmt+instance PrettyAnnotated StructField where prettyAnnUnresolved = printStructField+instance PrettyAnnotated TraitItem where prettyAnnUnresolved = printTraitItem+instance PrettyAnnotated TraitRef where prettyAnnUnresolved = printTraitRef+instance PrettyAnnotated Ty where prettyAnnUnresolved = printType+instance PrettyAnnotated TyParam where prettyAnnUnresolved = printTyParam+instance PrettyAnnotated TyParamBound where prettyAnnUnresolved = printBound+instance PrettyAnnotated Variant where prettyAnnUnresolved = printVariant+instance PrettyAnnotated UseTree where prettyAnnUnresolved = printUseTree+instance PrettyAnnotated Visibility where prettyAnnUnresolved = printVis+instance PrettyAnnotated WhereClause where prettyAnnUnresolved = printWhereClause True+instance PrettyAnnotated WherePredicate where prettyAnnUnresolved = printWherePredicate+
+ src/Language/Rust/Pretty/Internal.hs view
@@ -0,0 +1,1030 @@+{-|+Module : Language.Rust.Pretty.Internal+Description : Rust pretty printer+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++The pretty printing facilities in this file are re-exported to 'Language.Rust.Pretty' via the+'Pretty' and 'PrettyAnnotated' classes. There may be invariants in this module that are not properly+documented. +-}+{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}+{-# OPTIONS_HADDOCK hide, not-home #-}+{-# LANGUAGE OverloadedStrings #-}++module Language.Rust.Pretty.Internal (++ -- * Pretty printers+ -- As much as possible, these functions should say which function in the @rustc@ printer they are+ -- emulating.++ -- ** Top level+ printSourceFile,+ + -- ** General+ printMutability,+ printUnsafety,+ printFnArgsAndRet,+ printIdent,+ printName,+ + -- ** Paths+ printPath,+ + -- ** Attributes+ printAttr,+ + -- ** Literals+ printLit,+ printLitSuffix,+ printLitTok,+ + -- ** Expressions+ printExpr,+ printAbi,+ printUnOp,+ printBinOp,+ printField,+ printRangeLimits,+ + -- ** Types and lifetimes+ printType,+ printGenerics,+ printLifetime,+ printLifetimeDef,+ printTyParam,+ printBound,+ printWhereClause,+ printWherePredicate,+ printPolyTraitRef,+ printTraitRef,+ + -- ** Patterns+ printPat,+ printBindingMode,+ printFieldPat,+ + -- ** Statements+ printStmt,+ + -- ** Items+ printItem,+ printForeignItem,+ printImplItem,+ printTraitItem,+ printPolarity,+ printStructField,+ printVariant,+ printUseTree,+ printVis,+ + -- ** Blocks+ printBlock,++ -- ** Token trees+ printToken,+ printTt,+ printTokenStream,+ printNonterminal,+ printMac,++ -- * Utilities+ module Language.Rust.Pretty.Util,+) where++import Language.Rust.Pretty.Literals+import Language.Rust.Pretty.Util++import Language.Rust.Data.Ident+import Language.Rust.Data.Position++import Language.Rust.Syntax.AST+import Language.Rust.Syntax.Token++import Data.Text.Prettyprint.Doc hiding ( (<+>), hsep, indent, vsep )++import Data.Maybe ( maybeToList, fromMaybe )+import Data.Foldable ( toList )+import Data.List ( unfoldr )+import qualified Language.Rust.Parser.NonEmpty as N++-- | Print a source file+printSourceFile :: SourceFile a -> Doc a+printSourceFile (SourceFile shebang as items) = foldr1 (\x y -> x <#> "" <#> y) ls+ where ls = concat [ maybeToList ((\s -> "#!" <> pretty s) <$> shebang)+ , [ vcat [ printAttr a False | a <- as ] ]+ , punctuate line' (printItem `map` items)+ ]++-- | Print a name+printName :: Name -> Doc a+printName = pretty++printEmbeddedExpr :: String -> Doc a+printEmbeddedExpr s = "${e|" <> printName s <> "|}"++printEmbeddedIdent :: String -> Doc a+printEmbeddedIdent s = "${i|" <> pretty s <> "|}"++printIdentName :: IdentName -> Doc a+printIdentName (Name n) = printName n+printIdentName (HaskellName n) = printEmbeddedIdent n++-- | Print an identifier+printIdent :: Ident -> Doc a+printIdent (Ident s False _) = printIdentName s+printIdent (Ident s True _) = "r#" <> printIdentName s ++-- | Print a type (@print_type@ with @print_ty_fn@ inlined)+-- Types are expected to always be only one line+printType :: Ty a -> Doc a+printType (Slice ty x) = annotate x ("[" <> printType ty <> "]")+printType (Array ty v x) = annotate x ("[" <> printType ty <> ";" <+> printExpr v <> "]")+printType (Ptr mut ty x) = annotate x ("*" <> printFullMutability mut <+> printType ty)+printType (Rptr lt mut ty x) = annotate x ("&" <> perhaps printLifetime lt <+> printMutability mut <+> printType ty)+printType (Never x) = annotate x "!"+printType (TupTy [elt] x) = annotate x (block Paren True "" mempty [ printType elt <> "," ])+printType (TupTy elts x) = annotate x (block Paren True "," mempty (printType `map` elts))+printType (PathTy Nothing p x) = annotate x (printPath p False)+printType (PathTy (Just q) p x) = annotate x (printQPath p q False)+printType (TraitObject bs x) = let prefix = if null (N.tail bs) then "dyn" else mempty+ in annotate x (printBounds prefix (toList bs))+printType (ImplTrait bs x) = annotate x (printBounds "impl" (toList bs))+printType (ParenTy ty x) = annotate x ("(" <> printType ty <> ")")+printType (Typeof e x) = annotate x ("typeof" <> block Paren True mempty mempty [ printExpr e ])+printType (Infer x) = annotate x "_"+printType (MacTy m x) = annotate x (printMac Bracket m)+printType (BareFn u a l d x) = annotate x (printFormalLifetimeList l+ <+> printFnHeaderInfo u NotConst a InheritedV+ <> printFnArgsAndRet d)++-- | Print a macro (@print_mac@)+printMac :: Delim -> Mac a -> Doc a+printMac d (Mac path ts x) = annotate x (printPath path False <> "!" <> body)+ where body = block d True mempty mempty [ printTokenStream ts ]++-- | Given two positions, find out how to print appropriate amounts of space between them+printSpaceBetween :: Bool -> Span -> Span -> Maybe (Doc a)+printSpaceBetween spaceNeeded (Span _ (Position _ y1 x1)) (Span (Position _ y2 x2) _)+ | y2 == y1 && x2 > x1 = Just $ hcat (replicate (x2 - x1) space)+ | y2 > y1 = Just $ hcat (replicate (y2 - y1) line) <> column (\x1' -> hcat (replicate (x2 - x1') space))+ | spaceNeeded = Just space + | otherwise = Just mempty+printSpaceBetween _ _ _ = Nothing ++-- | Print a token tree (@print_tt@)+printTt :: TokenTree -> Doc a+printTt (Token _ t) = printToken t+printTt (Delimited _ d ts) = block d True mempty mempty [ printTokenStream ts ] ++-- | Print a list of token trees, with the right amount of space between successive elements+printTokenTrees :: [TokenTree] -> Doc a+printTokenTrees [] = mempty+printTokenTrees [tt] = printTt tt+printTokenTrees (tt1:tt2:tts) = printTt tt1 <> sp <> printTokenTrees (tt2:tts)+ where+ extremities :: TokenTree -> (Token, Token)+ extremities (Token _ t ) = (t,t)+ extremities (Delimited _ d _) = (OpenDelim d, CloseDelim d)++ -- extremities in this particular situation+ (lastTt1, firstTt2) = (snd $ extremities tt1, fst $ extremities tt2)+ spNeeded = lastTt1 `spaceNeeded` firstTt2++ -- Spacing of tokens, as informed by positional information on tokens+ spPos = printSpaceBetween spNeeded (spanOf tt1) (spanOf tt2)++ -- Spacing of tokens, as informed by 'spaceNeeded' and special cases+ spTok = case (snd $ extremities tt1, fst $ extremities tt2) of+ (Comma, _) -> space+ (Colon, _) -> space+ (Semicolon, _) -> space+ (_, OpenDelim Brace) -> space+ (CloseDelim Brace, _) -> space+ (t1, t2) | t1 `elem` toksRequiringSp || t2 `elem` toksRequiringSp -> space + | otherwise -> if spNeeded then space else mempty++ -- List of tokens that want to have space on either side of them+ toksRequiringSp = [ Equal, GreaterEqual, GreaterGreaterEqual, EqualEqual, NotEqual, LessEqual,+ LessLessEqual, MinusEqual, AmpersandEqual, PipeEqual, PlusEqual, StarEqual,+ SlashEqual, CaretEqual, PercentEqual, RArrow, LArrow, FatArrow ]+ + -- Use 'spPos' with 'spTok' as a fallback+ sp = fromMaybe spTok spPos++-- | Print the space between a token stream and the mod-path before it+printTokenStreamSp :: TokenStream -> Doc a+printTokenStreamSp (Tree Token{}) = space+printTokenStreamSp (Tree Delimited{}) = mempty+printTokenStreamSp (Stream []) = mempty+printTokenStreamSp (Stream (t:_)) = printTokenStreamSp t++-- | Print a token stream+printTokenStream :: TokenStream -> Doc a+printTokenStream = printTokenTrees . unfoldr unconsTokenStream++-- | Print a token (@token_to_string@)+-- Single character expression-operator symbols.+printToken :: Token -> Doc a+printToken Equal = "="+printToken Less = "<"+printToken Greater = ">"+printToken Ampersand = "&"+printToken Pipe = "|"+printToken Exclamation = "!"+printToken Tilde = "~"+printToken Plus = "+"+printToken Minus = "-"+printToken Star = "*"+printToken Slash = "/"+printToken Percent = "%"+-- Multi character eexpression-operator symbols+printToken GreaterEqual = ">="+printToken GreaterGreaterEqual = ">>="+printToken AmpersandAmpersand = "&&"+printToken PipePipe = "||"+printToken LessLess = "<<"+printToken GreaterGreater = ">>"+printToken EqualEqual = "=="+printToken NotEqual = "!="+printToken LessEqual = "<="+printToken LessLessEqual = "<<="+printToken MinusEqual = "-="+printToken AmpersandEqual = "&="+printToken PipeEqual = "|="+printToken PlusEqual = "+="+printToken StarEqual = "*="+printToken SlashEqual = "/="+printToken CaretEqual = "^="+printToken PercentEqual = "%="+printToken Caret = "^"+-- Structural symbols+printToken At = "@"+printToken Dot = "."+printToken DotDot = ".."+printToken DotDotDot = "..."+printToken DotDotEqual = "..="+printToken Comma = ","+printToken Semicolon = ";"+printToken Colon = ":"+printToken ModSep = "::"+printToken RArrow = "->"+printToken LArrow = "<-"+printToken FatArrow = "=>"+printToken Pound = "#"+printToken Dollar = "$"+printToken Question = "?"+-- Delimiters, eg. @{@, @]@, @(@+printToken (OpenDelim Paren) = "("+printToken (OpenDelim Bracket) = "["+printToken (OpenDelim Brace) = "{"+printToken (OpenDelim NoDelim) = ""+printToken (CloseDelim Paren) = ")"+printToken (CloseDelim Bracket) = "]"+printToken (CloseDelim Brace) = "}"+printToken (CloseDelim NoDelim) = ""+-- Literals+printToken (LiteralTok l s) = noIndent $ printLitTok l <> perhaps printName s+-- Name components+printToken (IdentTok i) = printIdent i+printToken (LifetimeTok i) = "'" <> printIdent i+printToken (Space Whitespace _) = " "+printToken (Space Comment n) = "/*" <> printName n <> " */"+printToken (Doc d Inner True) = "/*!" <> printName d <> "*/"+printToken (Doc d Outer True) = "/**" <> printName d <> "*/"+printToken (Doc d Inner False) = "//!" <> printName d+printToken (Doc d Outer False) = "///" <> printName d+printToken Shebang = "#!"+-- Macro related +printToken (Interpolated n) = unAnnotate (printNonterminal n)+-- Other+printToken t = error $ "printToken: " ++ show t+++-- | Print a literal token+printLitTok :: LitTok -> Doc a+printLitTok (ByteTok n) = "b'" <> printName n <> "'"+printLitTok (CharTok n) = "'" <> printName n <> "'"+printLitTok (IntegerTok n) = printName n+printLitTok (FloatTok n) = printName n+printLitTok (StrTok n) = "\"" <> string hardline n <> "\""+printLitTok (StrRawTok n m) = let pad = pretty (replicate m '#')+ in "r" <> pad <> "\"" <> string hardline n <> "\"" <> pad+printLitTok (ByteStrTok n) = "b\"" <> string hardline n <> "\""+printLitTok (ByteStrRawTok n m) = let pad = pretty (replicate m '#') in "br" <> pad <> "\"" <> string hardline n <> "\"" <> pad++-- | Print a nonterminal+printNonterminal :: Nonterminal a -> Doc a+printNonterminal (NtItem item) = printItem item+printNonterminal (NtBlock blk) = printBlock blk+printNonterminal (NtStmt stmt) = printStmt stmt+printNonterminal (NtPat pat) = printPat pat+printNonterminal (NtExpr expr) = printExpr expr+printNonterminal (NtTy ty) = printType ty+printNonterminal (NtIdent ident) = printIdent ident+printNonterminal (NtPath path) = printPath path False+printNonterminal (NtTT tt) = printTt tt+printNonterminal (NtArm arm) = printArm arm+printNonterminal (NtImplItem item) = printImplItem item+printNonterminal (NtTraitItem item) = printTraitItem item+printNonterminal (NtGenerics generics) = printGenerics generics+printNonterminal (NtWhereClause clause) = printWhereClause True clause+printNonterminal (NtArg arg) = printArg arg True+printNonterminal (NtLit lit) = printLit lit++-- | Print a statement (@print_stmt@)+printStmt :: Stmt a -> Doc a+printStmt (ItemStmt item x) = annotate x (printItem item)+printStmt (NoSemi expr x) = annotate x (printExprOuterAttrStyle expr False <> when (requiresSemi expr) ";")+ where+ -- @parse::classify::expr_requires_semi_to_be_stmt@+ requiresSemi :: Expr a -> Bool+ requiresSemi If{} = False+ requiresSemi IfLet{} = False+ requiresSemi While{} = False+ requiresSemi WhileLet{} = False+ requiresSemi ForLoop{} = False+ requiresSemi Loop{} = False+ requiresSemi Match{} = False+ requiresSemi BlockExpr{} = False+ requiresSemi _ = True+printStmt (Semi expr x) = annotate x (printExprOuterAttrStyle expr False <> ";")+printStmt (MacStmt m ms as x) = annotate x (printOuterAttrs as </> printMac delim m <> end)+ where delim = case ms of { BracesMac -> Brace; _ -> Paren }+ end = case ms of { SemicolonMac -> ";"; _ -> mempty }+printStmt (Local p ty i as x) = annotate x (printOuterAttrs as <#> group ("let" <+> binding <+> initializer <> ";"))+ where binding = group (printPat p <> perhaps (\t -> ":" <#> indent n (printType t)) ty)+ initializer = perhaps (\e -> "=" <#> indent n (printExpr e)) i++-- | Print an expression+printExpr :: Expr a -> Doc a+printExpr expr = printExprOuterAttrStyle expr True++-- | Print an expression (@print_expr_outer_attr_style@)+-- Inlined @print_expr_in_place@, @print_expr_call@, @print_expr_method_call@, @print_expr_tup@,+-- @print_expr_binary@, @print_expr_unary@, @print_expr_addr_of@, @print_if@, @print_if_let@,+-- @print_expr_repeat@+--+-- TODO: attributes on chained method calls+printExprOuterAttrStyle :: Expr a -> Bool -> Doc a+printExprOuterAttrStyle expr isInline = glue (printEitherAttrs (expressionAttrs expr) Outer isInline) $+ case expr of+ Box _ e x -> annotate x ("box" <+> printExpr e)+ InPlace _ place e x -> annotate x (hsep [ printExpr place, "<-", printExpr e ])+ Vec as exprs x -> annotate x (block Bracket True "," (printInnerAttrs as) (printExpr <$> exprs))+ Call _ func [arg] x -> annotate x (printExpr func <> parens (printExpr arg))+ Call _ func args x -> annotate x (printExpr func <> block Paren True "," mempty (printExpr <$> args))+ MethodCall{} -> chainedMethodCalls expr False id+ TupExpr as [e] x -> annotate x (block Paren True "" (printInnerAttrs as) [ printExpr e <> "," ])+ TupExpr as es x -> annotate x (block Paren True "," (printInnerAttrs as) (printExpr <$> es))+ Binary _ op lhs rhs x -> annotate x (hsep [ printExpr lhs, printBinOp op, printExpr rhs ])+ Unary _ op e x -> annotate x (printUnOp op <> printExpr e)+ Lit _ lit x -> annotate x (printLit lit)+ Cast _ e ty x -> let f = case e of { Cast{} -> printExpr; _ -> printExpr }+ in annotate x (hsep [ f e, "as", printType ty ])+ TypeAscription _ e ty x -> annotate x (printExpr e <> ":" <+> printType ty)+ If _ test blk els x -> annotate x (hsep [ "if", printExpr test, printBlock blk, printElse els ])+ IfLet _ pats e blk els x -> annotate x (hsep [ "if let", printPats pats, "=", printExpr e, printBlock blk, printElse els ])+ While as test blk lbl x -> annotate x (hsep [ printLbl lbl, "while", printExpr test, printBlockWithAttrs True blk as ])+ WhileLet as ps e blk lbl x -> annotate x (hsep [ printLbl lbl, "while let", printPats ps, "=", printExpr e, printBlockWithAttrs True blk as ])+ ForLoop as pat e blk lbl x -> annotate x (hsep [ printLbl lbl, "for", printPat pat, "in", printExpr e, printBlockWithAttrs True blk as ])+ Loop as blk lbl x -> annotate x (hsep [ printLbl lbl, "loop", printBlockWithAttrs True blk as ])+ Match as e arms x -> annotate x (hsep [ "match", printExpr e, block Brace False "," (printInnerAttrs as) (printArm `map` arms) ])+ Closure _ s cap decl body x -> annotate x (hsep [ when (s == Immovable) "static"+ , when (cap == Value) "move"+ , printFnBlockArgs decl <+> printExpr body])+ BlockExpr attrs blk x -> annotate x (printBlockWithAttrs True blk attrs)+ Catch attrs blk x -> annotate x ("do catch" <+> printBlockWithAttrs True blk attrs)+ Assign _ lhs rhs x -> annotate x (hsep [ printExpr lhs, "=", printExpr rhs ])+ AssignOp _ op lhs rhs x -> annotate x (hsep [ printExpr lhs, printBinOp op <> "=", printExpr rhs ])+ FieldAccess{} -> chainedMethodCalls expr False id+ TupField{} -> chainedMethodCalls expr False id+ Index{} -> chainedMethodCalls expr False id+ Range _ start end limits x -> annotate x (perhaps printExpr start <+> printRangeLimits limits <+> perhaps printExpr end)+ PathExpr _ Nothing path x -> annotate x (printPath path True)+ PathExpr _ (Just qs) path x -> annotate x (printQPath path qs True)+ AddrOf _ mut e x -> annotate x ("&" <> printMutability mut <+> printExpr e)+ Break _ brk e x -> annotate x ("break" <+> printLbl' brk <+> perhaps printExpr e)+ Continue _ cont x -> annotate x ("continue" <+> printLbl' cont)+ Ret _ result x -> annotate x ("return" <+> perhaps printExpr result)+ Yield _ result x -> annotate x ("yield" <+> perhaps printExpr result)+ MacExpr _ m x -> annotate x (printMac Paren m)+ Struct as p fs Nothing x -> annotate x (printPath p True <+> block Brace True "," (printInnerAttrs as) (printField `map` fs))+ Struct as p fs (Just d) x -> let body = [ printField f <> "," | f <- fs ] ++ [ ".." <> printExpr d ] + in annotate x (printPath p True <+> block Brace True mempty (printInnerAttrs as) body)+ Repeat attrs e cnt x -> annotate x (brackets (printInnerAttrs attrs <+> printExpr e <> ";" <+> printExpr cnt))+ ParenExpr attrs e x -> annotate x (parens (printInnerAttrs attrs <+> printExpr e))+ Try{} -> chainedMethodCalls expr False id+ EmbeddedExpr _ e x -> annotate x (printEmbeddedExpr e)+ where+ printLbl = perhaps (\(Label n x) -> annotate x ("'" <> printName n) <> ":")+ printLbl' = perhaps (\(Label n x) -> annotate x ("'" <> printName n))+ glue = if isInline then (<+>) else (</>)++ -- | From an expression, separate the first non-method-call from the list of method call suffixes+ --+ -- Collects in the list+ -- * methods+ -- * field accesses+ --+ -- Allows interweaving+ -- * tuple field accesses+ -- * array indexes+ -- * try+ --+ chainedMethodCalls :: Expr a -- ^ expression+ -> Bool -- ^ last expression was a 'TupField' (if we have two+ -- successive 'TupField's, we need a space between them+ -- to prevent them from looking like a float literal)+ -> (Doc a -> Doc a) -- ^ suffix to the expression+ -> Doc a+ chainedMethodCalls (MethodCall _ s i ts' as x) _ fdoc+ = let tys = perhaps (\ts -> "::<" <> commas ts printType <> ">") ts'+ as' = case as of+ [a] -> parens (printExpr a)+ _ -> block Paren True "," mempty (printExpr <$> as)+ in chainedMethodCalls s False (annotate x . (<##> fdoc (indent n (hcat [ ".", printIdent i, tys, as' ]))))+ chainedMethodCalls (FieldAccess _ s i x) _ fdoc+ = chainedMethodCalls s False (annotate x . (<##> fdoc (indent n (hcat [ ".", printIdent i ]))))+ chainedMethodCalls (Try _ s x) _ fdoc+ = chainedMethodCalls s False (annotate x . (<> fdoc "?"))+ chainedMethodCalls (Index _ s i x) _ fdoc+ = chainedMethodCalls s False (annotate x . (<> fdoc ("[" <> block NoDelim True mempty mempty [printExpr i] <> "]")))+ chainedMethodCalls (TupField _ s i x) t fdoc+ = chainedMethodCalls s True (annotate x . (<> fdoc ("." <> pretty i <> when t " ")))+ chainedMethodCalls e _ fdoc = group (fdoc (printExpr e))++-- | Print a string literal+printStr :: StrStyle -> String -> Doc a+printStr sty str = unAnnotate (printLit (Str str sty Unsuffixed ()))++-- | Extract from an expression its attributes+expressionAttrs :: Expr a -> [Attribute a]+expressionAttrs (Box as _ _) = as+expressionAttrs (InPlace as _ _ _) = as+expressionAttrs (Vec as _ _) = as+expressionAttrs (Call as _ _ _) = as+expressionAttrs (MethodCall as _ _ _ _ _) = as+expressionAttrs (TupExpr as _ _) = as+expressionAttrs (Binary as _ _ _ _) = as+expressionAttrs (Unary as _ _ _) = as+expressionAttrs (Lit as _ _) = as+expressionAttrs (Cast as _ _ _) = as+expressionAttrs (TypeAscription as _ _ _) = as+expressionAttrs (If as _ _ _ _) = as+expressionAttrs (IfLet as _ _ _ _ _) = as+expressionAttrs (While as _ _ _ _) = as+expressionAttrs (WhileLet as _ _ _ _ _) = as+expressionAttrs (ForLoop as _ _ _ _ _) = as+expressionAttrs (Loop as _ _ _) = as+expressionAttrs (Match as _ _ _) = as+expressionAttrs (Closure as _ _ _ _ _) = as+expressionAttrs (BlockExpr as _ _) = as+expressionAttrs (Catch as _ _) = as+expressionAttrs (Assign as _ _ _) = as+expressionAttrs (AssignOp as _ _ _ _) = as+expressionAttrs (FieldAccess as _ _ _) = as+expressionAttrs (TupField as _ _ _) = as+expressionAttrs (Index as _ _ _) = as+expressionAttrs (Range as _ _ _ _) = as+expressionAttrs (PathExpr as _ _ _) = as+expressionAttrs (AddrOf as _ _ _) = as+expressionAttrs (Break as _ _ _) = as+expressionAttrs (Continue as _ _) = as+expressionAttrs (Ret as _ _) = as+expressionAttrs (MacExpr as _ _) = as+expressionAttrs (Struct as _ _ _ _) = as+expressionAttrs (Repeat as _ _ _) = as+expressionAttrs (ParenExpr as _ _) = as+expressionAttrs (Try as _ _) = as+expressionAttrs (Yield as _ _) = as+expressionAttrs (EmbeddedExpr as _ _) = as++-- | Print a field+printField :: Field a -> Doc a+printField (Field ident Nothing x) = annotate x (printIdent ident)+printField (Field ident (Just expr) x) = annotate x (printIdent ident <>":" <+> printExpr expr)++-- | Print range limits+printRangeLimits :: RangeLimits -> Doc a+printRangeLimits HalfOpen = ".."+printRangeLimits Closed = "..="++-- | Print a closure function declaration (@print_fn_block_args@)+printFnBlockArgs :: FnDecl a -> Doc a+printFnBlockArgs (FnDecl args ret _ x) = annotate x ("|" <> args' <> "|" <+> ret')+ where ret' = perhaps (\ty -> "->" <+> printType ty) ret+ args' = commas args (`printArg` True)++-- | Print the arm of a match expression (@print_arm@)+printArm :: Arm a -> Doc a+printArm (Arm as pats guard body x) = annotate x $ printOuterAttrs as+ </> printPats pats + <+> perhaps (\e -> "if" <+> printExpr e) guard+ <+> "=>"+ <+> printExpr body++printPats :: Foldable f => f (Pat a) -> Doc a+printPats pats = group (foldr1 (\a b -> a <+> "|" <#> b) (printPat `map` toList pats))++-- | Print a block+printBlock :: Block a -> Doc a+printBlock blk = printBlockWithAttrs True blk []++-- | Print a block with attributes (@print_block_with_attrs@ or @print_block_maybe_unclosed@)+printBlockWithAttrs :: Bool -> Block a -> [Attribute a] -> Doc a+printBlockWithAttrs b (Block stmts rules x) as = annotate x (printUnsafety rules <+> block Brace b mempty (printInnerAttrs as) stmts')+ where+ stmts' | null stmts = []+ | otherwise = body ++ [ lastStmt ]++ body = printStmt `map` Prelude.init stmts+ + lastStmt = case last stmts of+ NoSemi expr _ -> printExprOuterAttrStyle expr False+ stmt -> printStmt stmt++-- | Print an @else@ expression (@print_else@)+printElse :: Maybe (Expr a) -> Doc a+printElse Nothing = mempty+printElse (Just (If _ e t s x)) = annotate x (hsep [ "else if", printExpr e, printBlock t, printElse s ])+printElse (Just (IfLet _ p e t s x)) = annotate x (hsep [ "else if let", printPats p, "=", printExpr e, printBlock t, printElse s ])+printElse (Just (BlockExpr _ blk x)) = annotate x (hsep [ "else", printBlock blk ])+printElse _ = error "printElse saw `if` with a weird alternative"++-- | Print a binary operator +printBinOp :: BinOp -> Doc a+printBinOp AddOp = "+"+printBinOp SubOp = "-"+printBinOp MulOp = "*"+printBinOp DivOp = "/"+printBinOp RemOp = "%"+printBinOp AndOp = "&&"+printBinOp OrOp = "||"+printBinOp BitXorOp = "^"+printBinOp BitAndOp = "&"+printBinOp BitOrOp = "|"+printBinOp ShlOp = "<<"+printBinOp ShrOp = ">>"+printBinOp EqOp = "=="+printBinOp LtOp = "<"+printBinOp LeOp = "<="+printBinOp NeOp = "!="+printBinOp GeOp = ">="+printBinOp GtOp = ">"++-- | Print a unary operator+printUnOp :: UnOp -> Doc a+printUnOp Deref = "*"+printUnOp Not = "!"+printUnOp Neg = "-" ++-- | Print inner attributes (@print_inner_attributes@ or @print_inner_attributes_inline@+-- or @print_inner_attributes_nodbreak@ - distinction has to be made at callsite+-- whether to force newline)+printInnerAttrs :: [Attribute a] -> Doc a+printInnerAttrs attrs = printEitherAttrs attrs Inner False++-- | Print outer attributes (@print_outer_attributes@ or @print_outer_attributes_no_trailing_hardbreak@)+printOuterAttrs :: [Attribute a] -> Doc a+printOuterAttrs attrs = printEitherAttrs attrs Outer False++-- | Print either type of attributes (@print_either_attributes@)+printEitherAttrs :: [Attribute a] -> AttrStyle -> Bool -> Doc a+printEitherAttrs attrs kind inline = unless (null attrs') (glue attrs')+ where glue = if inline then hsep else vcat+ attrs' = [ printAttr attr inline | attr <- attrs, style attr == kind ]++ style (Attribute sty _ _ _) = sty+ style (SugaredDoc sty _ _ _) = sty++-- | Print an attribute (@print_attribute_inline@ or @print_attribute@)+printAttr :: Attribute a -> Bool -> Doc a+printAttr (Attribute Inner p ts x) _ = annotate x ("#![" <> printPath p True <> printTokenStreamSp ts <> printTokenStream ts <> "]")+printAttr (Attribute Outer p ts x) _ = annotate x ("#[" <> printPath p True <> printTokenStreamSp ts <> printTokenStream ts <> "]")+printAttr (SugaredDoc Inner True c x) _ = annotate x (noIndent ("/*!" <> string hardline c <> "*/"))+printAttr (SugaredDoc Outer True c x) _ = annotate x (noIndent ("/**" <> string hardline c <> "*/"))+printAttr (SugaredDoc Inner False c x) _ = annotate x (flatAlt ("//!" <> pretty c) ("/*!" <> pretty c <> "*/"))+printAttr (SugaredDoc Outer False c x) _ = annotate x (flatAlt ("///" <> pretty c) ("/**" <> pretty c <> "*/"))++-- | Print an identifier as is, or as cooked string if containing a hyphen+printCookedIdent :: Ident -> Doc a+printCookedIdent ident@(Ident (Name str) raw _)+ | '-' `elem` str && not raw = printStr Cooked str+ | otherwise = printIdent ident+printCookedIdent ident@(Ident (HaskellName _) _ _)+ = printIdent ident++-- | Print an item (@print_item@)+printItem :: Item a -> Doc a+printItem (ExternCrate as vis ident p x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, "extern", "crate", perhaps (\p' -> printCookedIdent p' <+> "as") p, printIdent ident <> ";" ]++printItem (Use as vis ut x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, "use", printUseTree ut <> ";" ]++printItem (Static as vis ident ty m e x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, "static", printMutability m, printIdent ident <> ":", printType ty, "=", printExpr e <> ";" ]++printItem (ConstItem as vis ident t e x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, "const", printIdent ident <> ":", printType t, "=", printExpr e <> ";" ]++printItem (Fn as vis ident d s c a t b x) = annotate x $ align $ printOuterAttrs as <#>+ printFn d s c a (Just ident) t vis (Just (b, as))++printItem (Mod as vis ident items x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, "mod", printMod ident items as ]++printItem (ForeignMod as vis a i x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, printAbi a, printForeignMod i as ]++printItem (TyAlias as vis ident ty ps x) = annotate x $ align $ printOuterAttrs as <#>+ let wc = printWhereClause True (whereClause ps)+ leading = printVis vis <+> "type" <+> printIdent ident <> printGenerics ps+ in emptyElim (group (leading <+> "=" <#> indent n (printType ty <> ";")))+ (\w -> vsep [leading, w, "=" <+> printType ty <> ";"])+ wc++printItem (Enum as vis ident vars ps x) = annotate x $ align $ printOuterAttrs as <#>+ printEnumDef vars ps ident vis++printItem (StructItem as vis ident s g x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, "struct", printStruct s g ident True True ]++printItem (Union as vis ident s g x) = annotate x $ align $ printOuterAttrs as <#>+ hsep [ printVis vis, "union", printStruct s g ident True True ]++printItem (Trait as vis ident a u g tys i x) = annotate x $ align $ printOuterAttrs as <#> + let leading = hsep [ printVis vis, printUnsafety u, when a "auto", "trait"+ , printIdent ident <> printGenerics g <> printBounds ":" tys+ ]+ lagging = block Brace False mempty (printInnerAttrs as) (printTraitItem `map` i)+ wc = printWhereClause True (whereClause g)+ in emptyElim (leading <+> lagging)+ (\w -> vsep [leading, w, lagging])+ wc++printItem (TraitAlias as vis ident g bds x) = annotate x $ align $ printOuterAttrs as <#>+ let leading = printVis vis <+> "trait" <+> printIdent ident <> printGenerics g+ in group (leading <#> indent n (printBounds "=" (toList bds)) <> ";")++printItem (Impl as vis d u p g t ty i x) = annotate x $ align $ printOuterAttrs as <#> + let generics = case g of { Generics [] [] _ _ -> mempty; _ -> printGenerics g }+ traitref = perhaps (\t' -> printPolarity p <> printTraitRef t' <+> "for") t+ leading = hsep [ printVis vis, printDef d, printUnsafety u+ , "impl" <> generics, traitref, printType ty+ ]+ lagging = block Brace False mempty (printInnerAttrs as) (printImplItem `map` i)+ wc = printWhereClause True (whereClause g)+ in emptyElim (leading <+> lagging)+ (\w -> vsep [leading, w, lagging])+ wc++printItem (MacItem as i (Mac p ts y) x) = annotate x $ annotate y $ align $ printOuterAttrs as <#>+ (printPath p True <> "!" <+> perhaps printIdent i <+> block Brace True mempty mempty [ printTokenStream ts ])++printItem (MacroDef as i ts x) = annotate x $ align $ printOuterAttrs as <#>+ ("macro_rules" <> "!" <+> printIdent i <+> block Brace True mempty mempty [ printTokenStream ts ])+++-- | Print a trait item (@print_trait_item@)+printTraitItem :: TraitItem a -> Doc a+printTraitItem (ConstT as ident ty expr x) = annotate x $ printOuterAttrs as <#> printAssociatedConst ident ty expr InheritedV+printTraitItem (MethodT as ident g sig body x) = annotate x $ printOuterAttrs as <#> printMethodSig ident g sig InheritedV (fmap (\b -> (b, as)) body)+printTraitItem (TypeT as ident bounds ty x) = annotate x $ printOuterAttrs as <#> printAssociatedType ident (Just bounds) ty+printTraitItem (MacroT as m x) = annotate x $ printOuterAttrs as <#> printMac Paren m <> ";"++-- | Print type parameter bounds with the given prefix, but only if there are any bounds (@print_bounds@)+printBounds :: Doc a -> [TyParamBound a] -> Doc a+printBounds _ [] = mempty+printBounds prefix bs = group (prefix <#> ungroup (block NoDelim False " +" mempty (printBound `map` bs)))++-- | Print a type parameter bound+printBound :: TyParamBound a -> Doc a+printBound (RegionTyParamBound lt x) = annotate x $ printLifetime lt+printBound (TraitTyParamBound tref modi x) = annotate x $ when (modi == Maybe) "?" <> printPolyTraitRef tref++-- | Print the formal lifetime list (@print_formal_lifetime_list@)+printFormalLifetimeList :: [LifetimeDef a] -> Doc a+printFormalLifetimeList [] = mempty+printFormalLifetimeList defs = "for" <> angles (align (fillSep (punctuate "," (printDef `map` defs))))+ where printDef (LifetimeDef as lt bds x) = annotate x (printOuterAttrs as <+> flatten (printLifetimeBounds lt bds))++-- | Print an impl item (@print_impl_item@)+printImplItem :: ImplItem a -> Doc a+printImplItem (ConstI as vis def ident ty expr x) = annotate x $ printOuterAttrs as <#>+ (printVis vis <+> printDef def <+> printAssociatedConst ident ty (Just expr) InheritedV)+printImplItem (MethodI as vis def ident g sig body x) = annotate x $ printOuterAttrs as <#>+ (printVis vis <+> printDef def <+> printMethodSig ident g sig InheritedV (Just (body, as)))+printImplItem (TypeI as vis def ident ty x) = annotate x $ printOuterAttrs as <#>+ (printVis vis <+> printDef def <+> printAssociatedType ident Nothing (Just ty))+printImplItem (MacroI as def mac x) = annotate x $ printOuterAttrs as <#>+ (printDef def <+> printMac Paren mac <> ";")++-- | Print defaultness (@Defaultness@)+printDef :: Defaultness -> Doc a+printDef Default = "default"+printDef Final = mempty ++-- | Print an associated type (@printAssociatedType@)+printAssociatedType :: Ident -> Maybe [TyParamBound a] -> Maybe (Ty a) -> Doc a+printAssociatedType ident bounds_m ty_m = "type" <+> (printIdent ident+ <> perhaps (printBounds ":") bounds_m)+ <+> perhaps (\ty -> "=" <+> printType ty) ty_m+ <> ";"++-- | Print a method signature (@print_method_sig@)+printMethodSig :: Ident -> Generics a -> MethodSig a -> Visibility a -> Maybe (Block a, [Attribute a]) -> Doc a+printMethodSig ident generics (MethodSig unsafety constness abi decl)+ = printFn decl unsafety constness abi (Just ident) generics++-- | Print an associated constant (@print_associated_const@)+printAssociatedConst :: Ident -> Ty a -> Maybe (Expr a) -> Visibility a -> Doc a+printAssociatedConst ident ty default_m vis = printVis vis+ <+> "const" <+> printIdent ident <> ":" <+> printType ty+ <+> perhaps (\expr -> "=" <+> printExpr expr) default_m+ <> ";"++-- | Print the polarity of a trait+printPolarity :: ImplPolarity -> Doc a+printPolarity Negative = "!"+printPolarity Positive = mempty++-- | Print visibility (@print_visibility@)+printVis :: Visibility a -> Doc a+printVis PublicV = "pub"+printVis CrateV = "pub(crate)"+printVis (RestrictedV path@(Path False [PathSegment "super" Nothing _] _)) = "pub(" <> printPath path False <> ")"+printVis (RestrictedV path@(Path False [PathSegment "self" Nothing _] _)) = "pub(" <> printPath path False <> ")"+printVis (RestrictedV path) = "pub(" <> "in" <+> printPath path False <> ")"+printVis InheritedV = mempty++-- | Print a foreign item (@print_foreign_item@)+printForeignItem :: ForeignItem a -> Doc a+printForeignItem (ForeignFn attrs vis ident decl generics x) = annotate x $+ printOuterAttrs attrs <#> printFn decl Normal NotConst Rust (Just ident) generics vis Nothing+printForeignItem (ForeignStatic attrs vis ident ty mut x) = annotate x $+ printOuterAttrs attrs <#> printVis vis <+> "static" <+> printMutability mut <+> printIdent ident <> ":" <+> printType ty <> ";"+printForeignItem (ForeignTy attrs vis ident x) = annotate x $+ printOuterAttrs attrs <#> printVis vis <+> "type" <+> printIdent ident <> ";"++-- | Print a struct definition (@print_struct@)+printStruct :: VariantData a -> Generics a -> Ident -> Bool -> Bool -> Doc a+printStruct structDef generics ident printFinalizer annotateGenerics =+ printIdent ident <> gen+ <> case (structDef, whereClause generics) of + (StructD fields x, WhereClause [] _) -> annotate x $ space <> block Brace False "," mempty (printStructField `map` fields)+ (StructD fields x, wc) -> annotate x $ line <> printWhereClause True wc <#> block Brace False "," mempty (printStructField `map` fields)+ (TupleD fields x, WhereClause [] _) -> annotate x $ block Paren True "," mempty (printStructField `map` fields) <> when printFinalizer ";" + (TupleD fields x, wc) -> annotate x $ block Paren True "," mempty (printStructField `map` fields) <#> printWhereClause (not printFinalizer) wc <> when printFinalizer ";" + (UnitD x, WhereClause [] _) -> annotate x $ when printFinalizer ";"+ (UnitD x, wc) -> annotate x $ line <> printWhereClause (not printFinalizer) wc <> when printFinalizer ";"+ where gen = if annotateGenerics then printGenerics generics else unAnnotate (printGenerics generics)++-- | Print a struct field+printStructField :: StructField a -> Doc a+printStructField (StructField i v t as x) = annotate x (printOuterAttrs as <#> hsep [ printVis v, perhaps (\i' -> printIdent i' <> ":") i, printType t ])++-- | Pretty print unsafety (@print_unsafety@)+printUnsafety :: Unsafety -> Doc a+printUnsafety Normal = mempty+printUnsafety Unsafe = "unsafe"++-- | Print an enum definition (@print_enum_def@)+printEnumDef :: [Variant a] -> Generics a -> Ident -> Visibility a -> Doc a+printEnumDef variants generics ident vis =+ case whereClause generics of+ WhereClause [] _ -> leading <+> lagging+ wc -> leading <#> printWhereClause True wc <#> lagging+ where leading = printVis vis <+> "enum" <+> (printIdent ident <> printGenerics generics)+ lagging = block Brace False "," mempty [ printOuterAttrs as <#> printVariant v | v@(Variant _ as _ _ _) <- variants ]++-- | Print a variant (@print_variant@)+printVariant :: Variant a -> Doc a+printVariant (Variant i _ _data e x) = annotate x (body <+> disc)+ where body = printStruct _data (Generics [] [] (WhereClause [] undefined) undefined) i False False+ disc = perhaps (\e' -> "=" <+> printExpr e') e++-- | Print a where clause (@print_where_clause@). The 'Bool' argument indicates whether to have a+-- trailing comma or not.+printWhereClause :: Bool -> WhereClause a -> Doc a+printWhereClause trailing (WhereClause predicates x)+ | null predicates = mempty+ | trailing = annotate x ("where" <#> block NoDelim False "," mempty (printWherePredicate `map` predicates))+ | otherwise = annotate x ("where" <#> block NoDelim False mempty mempty (punctuate "," (printWherePredicate `map` predicates)))++-- | Print a where clause predicate+printWherePredicate :: WherePredicate a -> Doc a+printWherePredicate (BoundPredicate blt ty bds y) = annotate y (printFormalLifetimeList blt <+> printType ty <> printBounds ":" bds)+printWherePredicate (RegionPredicate lt bds y) = annotate y (printLifetimeBounds lt bds)+printWherePredicate (EqPredicate lhs rhs y) = annotate y (printType lhs <+> "=" <+> printType rhs)++-- | Print a function (@print_fn@)+printFn :: FnDecl a -> Unsafety -> Constness -> Abi -> Maybe Ident -> Generics a -> Visibility a -> Maybe (Block a, [Attribute a]) -> Doc a+printFn decl unsafety constness abi name generics vis blkAttrs =+ printFnHeaderInfo unsafety constness abi vis+ <+> perhaps printIdent name+ <> printGenerics generics+ <> printFnArgsAndRet decl+ <+#> whereBlk+ where+ ((<+#>), whereBlk) = case (whereClause generics, blkAttrs) of+ (WhereClause [] _, Nothing) -> ((<>), ";")+ (WhereClause [] _, Just (blk, attrs)) -> ((<+>), printBlockWithAttrs False blk attrs)+ (wc, Nothing) -> ((<#>), printWhereClause False wc <> ";")+ (wc, Just (blk, attrs)) -> ((<#>), printWhereClause True wc <#> printBlockWithAttrs False blk attrs)+++-- | Print the function arguments and the return type (@print_fn_args_and_ret@)+printFnArgsAndRet :: FnDecl a -> Doc a+printFnArgsAndRet (FnDecl args ret var x)+ | var = annotate x (block Paren True mempty mempty ([ printArg a False <> "," | a <- args ] ++ [ "..." ]) <+> ret')+ | otherwise = annotate x (block Paren True "," mempty [ printArg a False | a <- args ] <+> ret')+ where ret' = perhaps (\t -> "->" <+> printType t) ret++-- | Print an argument (@print_arg@)+printArg :: Arg a -> Bool -> Doc a+printArg (Arg (Just pat) (Infer x') x) True = annotate x $ annotate x' (printPat pat)+printArg (Arg Nothing ty x) _ = annotate x (printType ty)+printArg (Arg (Just pat) ty x) _ = annotate x (printPat pat <> ":" <+> printType ty)+printArg (SelfValue mut x) _ = annotate x (printMutability mut <+> "self")+printArg (SelfRegion lt mut x) _ = annotate x ("&" <> hsep [perhaps printLifetime lt, printMutability mut, "self"])+printArg (SelfExplicit ty mut x) _ = annotate x (printMutability mut <+> "self" <> ":" <+> printType ty)++-- | Print a lifetime (@print_lifetime@)+printLifetime :: Lifetime a -> Doc a+printLifetime (Lifetime n x) = annotate x ("'" <> printName n)++-- | Print a lifetime definition+printLifetimeDef :: LifetimeDef a -> Doc a+printLifetimeDef (LifetimeDef as lt bds x) = annotate x (printOuterAttrs as <+> printLifetimeBounds lt bds)++-- | Print mutability (@print_mutability@)+printMutability :: Mutability -> Doc a+printMutability Mutable = "mut"+printMutability Immutable = mempty++-- | Like 'printMutability', but prints @const@ in the immutable case +printFullMutability :: Mutability -> Doc a+printFullMutability Mutable = "mut"+printFullMutability Immutable = "const"++-- | Print a pattern (@print_pat@)+printPat :: Pat a -> Doc a+printPat (WildP x) = annotate x "_"+printPat (IdentP bm p s x) = annotate x (printBindingMode bm <+> printIdent p <+> perhaps (\p' -> "@" <+> printPat p') s)+printPat (StructP p fs False x) = annotate x (printPath p True <+> block Brace True "," mempty (printFieldPat `map` fs))+printPat (StructP p fs True x) = annotate x (printPath p True <+> block Brace True mempty mempty ([ printFieldPat f <> "," | f <- fs ] ++ [ ".." ]))+printPat (TupleStructP p es Nothing x) = annotate x (printPath p True <> "(" <> commas es printPat <> ")")+printPat (TupleStructP p es (Just d) x) = let (before,after) = splitAt d es+ in annotate x (printPath p True <> "(" <> commas before printPat <> when (d /= 0) ","+ <+> ".." <> when (d /= length es) ("," <+> commas after printPat) <> ")")+printPat (PathP Nothing path x) = annotate x (printPath path True)+printPat (PathP (Just qself) path x) = annotate x (printQPath path qself True)+printPat (TupleP [elt] Nothing x) = annotate x ("(" <> printPat elt <> ",)")+printPat (TupleP elts Nothing x) = annotate x ("(" <> commas elts printPat <> ")")+printPat (TupleP elts (Just ddpos) _) = let (before,after) = splitAt ddpos elts+ in "(" <> commas before printPat <> unless (null before) ","+ <+> ".." <> unless (null after) ("," <+> commas after printPat) <> ")"+printPat (BoxP inner x) = annotate x ("box" <+> printPat inner)+printPat (RefP inner mutbl x) = annotate x ("&" <> printMutability mutbl <+> printPat inner)+printPat (LitP expr x) = annotate x (printExpr expr)+printPat (RangeP lo hi x) = annotate x (printExpr lo <+> "..=" <+> printExpr hi)+printPat (SliceP pb Nothing pa x) = annotate x ("[" <> commas (pb ++ pa) printPat <> "]")+printPat (SliceP pb (Just ps) pa x) = annotate x ("[" <> commas pb printPat <> ps' <+> commas pa printPat <> "]")+ where ps' = hcat [ unless (null pb) ","+ , space+ , case ps of WildP{} -> mempty+ _ -> printPat ps+ , ".."+ , unless (null pa) ","+ ]+printPat (MacP m x) = annotate x (printMac Paren m)++-- | Print a field pattern+printFieldPat :: FieldPat a -> Doc a+printFieldPat (FieldPat i p x) = annotate x (perhaps (\i -> printIdent i <> ":") i <+> printPat p)++-- | Print a binding mode+printBindingMode :: BindingMode -> Doc a+printBindingMode (ByRef mutbl) = "ref" <+> printMutability mutbl+printBindingMode (ByValue Immutable) = mempty+printBindingMode (ByValue Mutable) = "mut"++-- | Print the prefix of a function - all the stuff up to and including @fn@ (@print_fn_header_info@)+printFnHeaderInfo :: Unsafety -> Constness -> Abi -> Visibility a -> Doc a+printFnHeaderInfo u c a v = hsep [ printVis v, case c of { Const -> "const"; _ -> mempty }+ , printUnsafety u, printAbi a, "fn" ]++-- | Print the ABI+printAbi :: Abi -> Doc a+printAbi Rust = mempty+printAbi abi = "extern" <+> "\"" <> root abi <> "\""+ where+ root :: Abi -> Doc a+ root Cdecl = "cdecl"+ root Stdcall = "stdcall"+ root Fastcall = "fastcall"+ root Vectorcall = "vectorcall"+ root Aapcs = "aapcs"+ root Win64 = "win64"+ root SysV64 = "sysv64"+ root PtxKernel = "ptx-kernel"+ root Msp430Interrupt = "msp430-interrupt"+ root X86Interrupt = "x86-interrupt"+ root Rust = "Rust"+ root C = "C"+ root System = "system"+ root RustIntrinsic = "rust-intrinsic"+ root RustCall = "rust-call"+ root PlatformIntrinsic = "platform-intrinsic"+ root Unadjusted = "unadjusted"++ +-- | Print the interior of a module given the list of items and attributes in it (@print_mod@)+printMod :: Ident -> Maybe [Item a] -> [Attribute a] -> Doc a+printMod i (Just items) attrs = printIdent i <+> block Brace False mempty (printInnerAttrs attrs) (punctuate line' (printItem `map` items))+printMod i Nothing _ = printIdent i <> ";"++-- | Print the interior of a foreign module given the list of items and attributes in it (@print_mod@)+printForeignMod :: [ForeignItem a] -> [Attribute a] -> Doc a+printForeignMod items attrs = block Brace False mempty (printInnerAttrs attrs) (printForeignItem `map` items)++-- | Print generics (@print_generics@)+-- Remark: we are discarding the where clause because it gets printed seperately from the rest of+-- the generic.+printGenerics :: Generics a -> Doc a+printGenerics (Generics lifetimes tyParams _ x)+ | null lifetimes && null tyParams = mempty+ | otherwise = let lifetimes' = printLifetimeDef `map` lifetimes+ bounds' = [ printTyParam param | param<-tyParams ]+ in annotate x (group ("<" <##> ungroup (block NoDelim True "," mempty (lifetimes' ++ bounds')) <##> ">"))++-- | Print a poly-trait ref (@print_poly_trait_ref@)+printPolyTraitRef :: PolyTraitRef a -> Doc a+printPolyTraitRef (PolyTraitRef lts tref x) = annotate x (printFormalLifetimeList lts <+> printTraitRef tref)++-- | Print a trait ref (@print_trait_ref@)+printTraitRef :: TraitRef a -> Doc a+printTraitRef (TraitRef path) = printPath path False++-- | Print a path parameter and signal whether its generic (if any) should start with a colon (@print_path_parameters@)+printPathParameters :: PathParameters a -> Bool -> Doc a+printPathParameters (Parenthesized ins out x) colons = annotate x $+ when colons "::" <> parens (commas ins printType) <+> perhaps (\t -> "->" <+> printType t) out+printPathParameters (AngleBracketed lts tys bds x) colons = annotate x (when colons "::" <> "<" <> hsep (punctuate "," (lts' ++ tys' ++ bds')) <> ">")+ where+ lts' = printLifetime <$> lts+ tys' = printType <$> tys+ bds' = (\(ident,ty) -> printIdent ident <+> "=" <+> printType ty) <$> bds+++-- | Print a path, specifiying explicitly whether to include colons (@::@) before generics+-- or not (so expression style or type style generics) (@print_path@)+printPath :: Path a -> Bool -> Doc a+printPath (Path global segs x) colons = annotate x (when global "::" <> hcat (punctuate "::" (map (`printSegment` colons) segs)))++-- | Print a path segment+printSegment :: PathSegment a -> Bool -> Doc a+printSegment (PathSegment i ps x) colons = annotate x (printIdent i <> params)+ where params = perhaps (\p -> printPathParameters p colons) ps+++-- | Print a qualified path, specifiying explicitly whether to include colons (@::@) before+-- generics or not (so expression style or type style generics) (@print_qpath@)+printQPath :: Path a -> QSelf a -> Bool -> Doc a+printQPath (Path global segs x) (QSelf ty n) colons = hcat [ "<", printType ty <+> aliasedDoc, ">", "::", restDoc ]+ where+ (aliased, rest) = splitAt n segs+ + aliasedDoc = case aliased of+ [] -> mempty+ segs -> "as" <+> printPath (Path global segs x) False++ restDoc = printPath (Path False rest x) colons++-- | Print a use tree+printUseTree :: UseTree a -> Doc a+printUseTree (UseTreeSimple p Nothing x) = annotate x (printPath p True)+printUseTree (UseTreeSimple p (Just i) x) = annotate x (printPath p True <+> "as" <+> printIdent i)+printUseTree (UseTreeGlob p@(Path _ [] _) x) = annotate x (printPath p True <> "*")+printUseTree (UseTreeGlob p x) = annotate x (printPath p True <> "::*")+printUseTree (UseTreeNested p@(Path _ [] _) n x) = annotate x (printPath p True <> "{" <> hcat (punctuate ", " (map printUseTree n)) <> "}")+printUseTree (UseTreeNested p n x) = annotate x (printPath p True <> "::{" <> hcat (punctuate ", " (map printUseTree n)) <> "}")++-- | Print a type parameters (@print_ty_param@)+printTyParam :: TyParam a -> Doc a+printTyParam (TyParam as i bds def x) = annotate x $ hsep+ [ printOuterAttrs as+ , printIdent i <> printBounds ":" bds+ , perhaps (\def' -> "=" <+> printType def') def+ ]++-- | Print lifetime bounds (@print_lifetime_bounds@)+printLifetimeBounds :: Lifetime a -> [Lifetime a] -> Doc a+printLifetimeBounds lifetime bounds = printLifetime lifetime+ <> unless (null bounds) (":" <+> foldr1 (\x y -> x <+> "+" <+> y) (printLifetime <$> bounds))+
+ src/Language/Rust/Pretty/Literals.hs view
@@ -0,0 +1,138 @@+{-|+Module : Language.Rust.Pretty.Literals+Description : Parsing literals+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++Functions for pretty printing literals.+-}+{-# LANGUAGE OverloadedStrings #-}++module Language.Rust.Pretty.Literals (+ printLit,+ printLitSuffix,+) where++import Language.Rust.Syntax.AST+import Language.Rust.Pretty.Util++import Data.Text.Prettyprint.Doc ( hcat, annotate, (<>), Doc, pretty, group, hardline, flatAlt )++import Data.Char ( intToDigit, ord, chr )+import Data.Word ( Word8 )++-- | Print a literal (@print_literal@)+printLit :: Lit a -> Doc a+printLit lit = noIndent $ case lit of+ Str str Cooked s x -> annotate x (hcat [ "\"", group (foldMap (escapeChar True) str), "\"", suf s ])+ Str str (Raw m) s x -> annotate x (hcat [ "r", pad m, "\"", string hardline str, "\"", pad m, suf s ])+ ByteStr str Cooked s x -> annotate x (hcat [ "b\"", group (foldMap (escapeByte True) str), "\"", suf s ])+ ByteStr str (Raw m) s x -> annotate x (hcat [ "br", pad m, "\"", string hardline (map byte2Char str), "\"", pad m, suf s ])+ Char c s x -> annotate x (hcat [ "'", escapeChar False c, "'", suf s ])+ Byte b s x -> annotate x (hcat [ "b'", escapeByte False b, "'", suf s ])+ Int b i l s x -> annotate x (hcat [ printIntLit i b l, suf s ])+ Float d s x -> annotate x (hcat [ pretty d, suf s ])+ Bool True s x -> annotate x (hcat [ "true", suf s ])+ Bool False s x -> annotate x (hcat [ "false", suf s ])+ where+ pad :: Int -> Doc a+ pad m = pretty (replicate m '#')++ suf :: Suffix -> Doc a+ suf = printLitSuffix++-- | Print literal suffix+printLitSuffix :: Suffix -> Doc a+printLitSuffix Unsuffixed = mempty+printLitSuffix Is = "isize"+printLitSuffix I8 = "i8"+printLitSuffix I16 = "i16"+printLitSuffix I32 = "i32"+printLitSuffix I64 = "i64"+printLitSuffix I128 = "i128"+printLitSuffix Us = "usize"+printLitSuffix U8 = "u8"+printLitSuffix U16 = "u16"+printLitSuffix U32 = "u32"+printLitSuffix U64 = "u64"+printLitSuffix U128 = "u128"+printLitSuffix F32 = "f32"+printLitSuffix F64 = "f64"++-- | Print an integer literal+printIntLit :: Integer -> IntRep -> String -> Doc a+printIntLit i r len+ | i < 0 = "-" <> baseRep r <> printIntPrefix (show $ toNBase (abs i) (baseVal r)) len <> toNBase (abs i) (baseVal r)+ | i == 0 = baseRep r <> printIntPrefix "" len -- <> "0"+ | otherwise = baseRep r <> printIntPrefix (show $ toNBase (abs i) (baseVal r)) len <> toNBase (abs i) (baseVal r)+ where+ baseRep :: IntRep -> Doc a+ baseRep Bin = "0b"+ baseRep Oct = "0o"+ baseRep Dec = mempty+ baseRep Hex = "0x"++ baseVal :: IntRep -> Integer+ baseVal Bin = 2+ baseVal Oct = 8+ baseVal Dec = 10+ baseVal Hex = 16++ printIntPrefix :: String -> String -> Doc a+ printIntPrefix out ('0':'b':rest) = pretty $ replicate ((length rest) - (length out)) '0'+ printIntPrefix out ('0':'o':rest) = pretty $ replicate ((length rest) - (length out)) '0'+ printIntPrefix out ('0':'x':rest) = pretty $ replicate ((length rest) - (length out)) '0'+ printIntPrefix out rest = pretty $ replicate ((length rest) - (length out)) '0'+ -- = pretty $ take (fromIntegral $ l - (fromIntegral thing)) (repeat '0')++ toDigit :: Integer -> Char+ toDigit l = "0123456789ABCDEF" !! fromIntegral l++ toNBase :: Integer -> Integer -> Doc a+ l `toNBase` b | l < b = pretty (toDigit l)+ | otherwise = let ~(d,e) = l `quotRem` b in toNBase d b <> pretty (toDigit e)+++-- | Extend a byte into a unicode character+byte2Char :: Word8 -> Char+byte2Char = chr . fromIntegral++-- | Constrain a unicode character to a byte+-- This assumes the character is in the right range already+char2Byte :: Char -> Word8+char2Byte = fromIntegral . ord++-- | Escape a byte. Based on @std::ascii::escape_default@.+--+-- If the first argument is true, newlines may become a literal newline characters if the string is+-- too long.+escapeByte :: Bool -> Word8 -> Doc a+escapeByte nl w8 = case byte2Char w8 of+ '\t' -> "\\t"+ '\r' -> "\\r"+ '\\' -> "\\\\"+ '\'' -> "\\'"+ '"' -> "\\\""+ '\n'| nl -> flatAlt hardline "\\n"+ | otherwise -> "\\n"+ c | 0x20 <= w8 && w8 <= 0x7e -> pretty c+ _ -> "\\x" <> padHex 2 w8++-- | Escape a unicode character. Based on @std::ascii::escape_default@.+--+-- If the first argument is true, newlines may become a literal newline characters if the string is+-- too long.+escapeChar :: Bool -> Char -> Doc a+escapeChar nl c | c <= '\x7f' = escapeByte nl (char2Byte c)+ | c <= '\xffff' = "\\u{" <> padHex 4 (ord c) <> "}"+ | otherwise = "\\u{" <> padHex 6 (ord c) <> "}"++-- | Convert a number to its padded hexadecimal form+padHex :: Integral a => Int -> a -> Doc b+padHex i 0 = pretty (replicate i '0')+padHex i m = let (m',r) = m `divMod` 0x10+ in padHex (i-1) m' <> pretty (intToDigit (fromIntegral r))+
+ src/Language/Rust/Pretty/Resolve.hs view
@@ -0,0 +1,1515 @@+{-|+Module : Language.Rust.Pretty.Resolve+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++/NOTE:/ the following uses hithero unimplemented antiquoting syntax++An AST and its text form /should/ be completely isomorphic, with @parse@ and @pretty@ being the+functions allowing you to go back and forth between these forms. Unfortunately, this cannot really+be the case. The AST form can express programs which cannot be literally pretty printed and still+make sense. Sometimes, extra parens or semicolons need to be added.++== Simple example++For example, consider the following interaction++>>> import Language.Rust.Quote+>>> import Language.Rust.Pretty+>>> :set -XQuasiQuotes+>>> x = [expr| 2 + 3 |]+>>> y = [expr| 1 * $x |]+>>> pretty y+0 * 1 + 2++The problem is that we haven't introduced the paren AST node (which we would have gotten had we+parsed @1 * (2 + 3)@. This is where 'resolve' steps in.++>>> Right y' = resolve y+>>> pretty y'+0 * (1 + 2)++== More involved example++From the above, it is tempting to say: your pretty printer should be smarter! However, things are+not always so simple. Consider the less obvious example:++>>> fnBody = [expr| { let y = x; x += 1; y } + x |]+>>> fn = [item| fn foo(mut x: i32) -> i32 { $fnBody } |]+>>> pretty fn+fn foo(mut x: i32) -> i32 {+ { let y = x; x += 1; y } + x+}++This is clearly not the desired output - this won't compile with @rustc@ because of an invariant in+blocks: if the block ends in an expression, that expression cannot start with a block. To fix this,+we call 'resolve' on the AST before pretty printing it.++>>> Right fn' = resolve fn+>>> pretty fn'+fn foo(mut x: i32) -> i32 {+ ({ let y = x; x += 1; y }) + x+}++And now we have generated valid code.++-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedLists #-}++module Language.Rust.Pretty.Resolve (+ Resolve(resolve, resolve', resolveVerbose),+ Issue(..),+ Severity(..),+ ResolveFail(..),+) where++import Language.Rust.Syntax++import Language.Rust.Data.Ident ( Ident(..), mkIdent, IdentName(..) )+import Language.Rust.Data.InputStream ( inputStreamFromString )+import Language.Rust.Data.Position ( initPos, Spanned(..) )++import Language.Rust.Parser.Lexer ( lexTokens, lexToken )+import Language.Rust.Parser.ParseMonad ( execParser )++import Control.Exception ( throw, Exception )+import Control.Monad ( when )+import Control.Monad.Trans.RWS++import Data.Dynamic ( Dynamic, toDyn, Typeable )+import Data.List ( find )+import Language.Rust.Parser.NonEmpty ( NonEmpty(..) )+import qualified Language.Rust.Parser.NonEmpty as N+import qualified Data.List.NonEmpty as N2 ( NonEmpty(..) )+import Data.Maybe ( fromJust )+import Data.Semigroup ( (<>) )++{-# ANN module "HLint: ignore Reduce duplication" #-}++-- TODO:+-- * See where attributes are not allowed+-- * resolve in a better monad (`type ResolveM a = ReaderT [Doc] (Except ErrorType a)`)++-- | Diagnostic for how severe an 'Issue' is.+data Severity+ = Clean -- ^ Everything is normal (this variant is returned when there was nothing to resolve)+ | Warning -- ^ There is something fishy looking (AST is valid, but may not be what you expect)+ | Correction -- ^ The AST was invalid, but in a way that could be corrected+ | Error -- ^ The AST was invalid in some way that could not be automatically fixed+ deriving (Eq, Ord, Enum, Bounded, Show)++-- | Localized information about an issue in a syntax tree.+data Issue = Issue+ { description :: String+ -- ^ Description of the issue+ + , severity :: !Severity+ -- ^ Severity of the issue++ , location :: [Dynamic]+ -- ^ The first element in this list is the syntax tree where the issue occurs. The next elements+ -- are increasingly zoomed out syntax trees centered on the first element. In lieu of positional+ -- information, this provides a next best way of debugging exactly where the problem is.+ } deriving (Show)++-- | Monad in which to resolve a syntax tree.+--+-- * Reader is @['Dynamic']@ storing the path from root to the current syntax tree node+-- * Writer is @['Issue']@ accumulating issues met through the traversal+-- * State is 'Severity' accumulating the most severe 'Issue' found so far in the traversal+--+type ResolveM = RWS [Dynamic] [Issue] Severity++-- | Log an 'Issue'+logIssue :: String -- ^ description of the issue+ -> Severity -- ^ severity of the issue+ -> ResolveM ()+logIssue desc sev = do+ loc <- ask+ tell [Issue desc sev loc]+ modify (max sev)++-- | Log a 'Warning'+warn :: String -> ResolveM ()+warn desc = desc `logIssue` Warning++-- | Log a 'Correction'+correct :: String -> ResolveM ()+correct desc = desc `logIssue` Correction++-- | Log an 'Error'+err :: a -> String -> ResolveM a+err x desc = (desc `logIssue` Error) *> pure x++-- | Enter a new syntax tree+scope :: Typeable a => a -> ResolveM b -> ResolveM b+scope x = local (toDyn x :)++-- | Exceptions that occur during resolving. Unlike parse errors, we don't have positional+-- information. Instead, we try to provide some context via a list of syntax trees which+-- let you "zoom out" from the problematic node.+data ResolveFail = ResolveFail [Dynamic] String deriving (Typeable)++-- | Does not show context information+instance Show ResolveFail where+ showsPrec p (ResolveFail _ msg) = showParen (p >= 11) (showString expl)+ where expl = unwords [ "invalid AST", "(" ++ msg ++ ")" ]++instance Exception ResolveFail+++-- | Since it is possible to have well-typed Haskell expressions which represent invalid Rust ASTs,+-- it is convenient to fix, warn, or fail ASTs before printing them. The 'Resolve' typeclass+-- provides such a facility.+--+-- A non-exhaustive list of the more obvious issues it covers:+--+-- * missing parens+-- * invalid identifiers+-- * invalid paths (for example, generic arguments on a module path)+-- * inner attributes on things that support only outer attributes (and vice-versa)+--+class Resolve a where+ -- | Convert some value to its /resolved/ form. Informally, resolving a value involves checking+ -- that its invariants hold and, if they don't, report an error message or adjust the value so+ -- that the invariant holds.+ --+ -- A value of a type satsifying 'Language.Rust.Parser.Parse' and 'Language.Rust.Pretty.Pretty'+ -- is resolved if @'Language.Rust.Parser.parse' . 'Language.Rust.Pretty.pretty'@ is an identity+ -- operation on it. We further expect that 'resolve' be an identity operation on any output of+ -- 'Language.Rust.Parser.parse'.+ resolve :: a -> Either ResolveFail a+ resolve x = case runRWS (resolveM x) [] Clean of+ (_, Error, issues) ->+ let Issue desc _ locs = fromJust (find (\i -> severity i == Error) issues)+ in Left (ResolveFail locs desc)+ (t, _, _) -> Right t++ -- | Same as 'resolve', but throws a 'ResolveFail' exception if it cannot resolve. Although+ -- this function should not be used, it summarizes nicely the laws around 'Resolve':+ --+ -- prop> parse' . pretty' . resolve' == id+ -- prop> resolve' . parse' = parse'+ --+ resolve' :: a -> a+ resolve' = either throw id . resolve++ -- | Run resolution and get back the altered syntax tree, the highest 'Severity' of issues, and+ -- the list of issues found. This allows you to see what corrections were applied to the tree.+ -- If the output severity is 'Error', the syntax tree returned will still be invalid.+ resolveVerbose :: a -> (a, Severity, [Issue])+ resolveVerbose x = runRWS (resolveM x) [] Clean++ -- | Internal recursive helper+ resolveM :: a -> ResolveM a+++-- | A valid sourcefile needs+--+-- * the shebang to be one-line not conflicting with attributes+-- * the attributes to be inner+-- * the items to be 'ModItems'+--+resolveSourceFile :: (Typeable a, Monoid a) => SourceFile a -> ResolveM (SourceFile a)+resolveSourceFile s@(SourceFile sh as is) = scope s $ do+ sh' <- case sh of+ Just ('[':_) -> err sh "shebang cannot start with `['"+ Just s' | '\n' `elem` s' -> err sh "shebang cannot contain newlines"+ _ -> pure sh+ as' <- traverse (resolveAttr InnerAttr) as+ is' <- traverse (resolveItem ModItem) is+ pure (SourceFile sh' as' is')++instance (Typeable a, Monoid a) => Resolve (SourceFile a) where resolveM = resolveSourceFile++-- | An identifier can be invalid if+-- +-- * it does not lex into an identifier+-- * it is a keyword+--+resolveIdent :: Ident -> ResolveM Ident+resolveIdent i@(Ident (Name s) r _) =+ scope i $ case toks of+ Right [Spanned (IdentTok i') _]+ | i /= i' -> err i ("identifier `" ++ s ++ "' does not lex properly")+ | i `elem` keywords && not r -> do+ correct ("identifier `" ++ s ++ "' is a keyword")+ pure i{ raw = True }+ | otherwise -> pure i+ _ -> err i ("identifier `" ++ s ++ "' does not lex properly")++ where++ keywords = map mkIdent $ words "as box break const continue crate else enum extern false fn for\+ \ if impl in let loop match mod move mut pub ref return Self self\+ \ static struct super trait true type unsafe use where while\+ \ abstract alignof become do final macro offsetof override priv\+ \ proc pure sizeof typeof unsized virtual yield" + + s' = (if r then "r#" else "") ++ s+ toks = execParser (lexTokens lexToken) (inputStreamFromString s') initPos++resolveIdent i@(Ident (HaskellName _) _ _) = pure i++instance Resolve Ident where resolveM = resolveIdent+++----------------+-- Attributes --+----------------++-- | Attribute type to against which to resolve+data AttrType+ = EitherAttr -- ^ inner or outer attribute+ | InnerAttr -- ^ only innner attribute+ | OuterAttr -- ^ only outer attribute++-- | A sugared doc is invalid if+--+-- * the expected attribute style does not match the actual one+-- * its content starts with a '/' / '*' when it is an outer line / inline comment+-- * it is a line comment whose content spans multiple lines+--+-- A regular attribute is invalid if+--+-- * the expected attribute style does not match the actual one+-- * the underlying path / tokenstream are invalid+-- * the tokenstream starts with a '::'+--+resolveAttr :: (Typeable a, Monoid a) => AttrType -> Attribute a -> ResolveM (Attribute a)+resolveAttr typ s@(SugaredDoc sty inl con x) = scope s $ do + sty' <- case (typ, sty) of+ (OuterAttr, Inner) -> correct "inner attribute was turned into outer attribute" *> pure Outer+ (InnerAttr, Outer) -> correct "outer attribute was turned into inner attribute" *> pure Inner+ (_, sty' ) -> pure sty'+ con' <- case (con, inl, sty') of+ ('/':_, False, Outer) -> correct "the content of an outer (line) doc comment cannot start with a `/'" *> pure (' ':con)+ ('*':_, True, Outer) -> correct "the contents of an outer (inline) doc comment cannot start with a a`*'" *> pure (' ':con)+ (_, False, _) | '\n' `elem` con -> err con "a doc comment that is not inline cannot have multiple lines"+ _ -> pure con+ pure (SugaredDoc sty' inl con' x)++resolveAttr typ a@(Attribute sty p ts x) = scope a $ do+ sty' <- case (typ, sty) of+ (OuterAttr, Inner) -> correct "inner attribute was turned into outer attribute" *> pure Outer+ (InnerAttr, Outer) -> correct "outer attribute was turned into inner attribute" *> pure Inner+ (_, sty' ) -> pure sty'+ p' <- resolvePath ModPath p+ ts' <- resolveTokenStream ts+ case nextTok ts' of+ Just ModSep -> err () "the first token in the token stream `::' will be considered part of the path"+ _ -> pure ()+ pure (Attribute sty' p' ts' x)++ where++ nextTok :: TokenStream -> Maybe Token+ nextTok (Tree (Token _ t)) = Just t+ nextTok (Tree (Delimited _ d _)) = Just (OpenDelim d)+ nextTok (Stream (s:_)) = nextTok s+ nextTok (Stream []) = Nothing++instance (Typeable a, Monoid a) => Resolve (Attribute a) where resolveM = resolveAttr EitherAttr+++--------------+-- Literals --+--------------++-- | A literal cannot be invalid+resolveLit :: Lit a -> ResolveM (Lit a)+resolveLit = pure++instance Resolve (Lit a) where resolveM = resolveLit+++-----------+-- Paths --+-----------++-- | Recall that paths are reused for expressions, modules, and types. However, these paths have+-- different underlying invariants.+data PathType+ = ModPath+ | UsePath -- ^ similar to 'ModPath', but can have no segments+ | TypePath+ | ExprPath+ deriving (Eq)++instance Show PathType where+ show ModPath = "mod path"+ show UsePath = "use tree path"+ show TypePath = "type path"+ show ExprPath = "expression path"++-- | A path can be invalid if+--+-- * it has path parameters of the wrong type+-- * it has identifiers not meant for paths+--+-- TODO: guard against no path segments...+resolvePath :: (Typeable a, Monoid a) => PathType -> Path a -> ResolveM (Path a)+resolvePath t p@(Path _ [] _) | t /= UsePath = scope p $ err p "path must have at least one segment"+resolvePath t p@(Path g segs x) = scope p $+ if null [ () | PathSegment _ (Just a) _ <- segs, not (isParamsForPath t a) ]+ then Path g <$> traverse resolveSeg segs <*> pure x + else err p "path parameter is not valid for this type of path"+ where+ resolveSeg :: (Typeable a, Monoid a) => PathSegment a -> ResolveM (PathSegment a)+ resolveSeg (PathSegment i a x') = do+ i' <- case i of+ Ident (Name "self") False _ -> pure i+ Ident (Name "Self") False _ -> pure i+ Ident (Name "super") False _ -> pure i+ Ident (Name "crate") False _ -> pure i+ _ -> resolveIdent i+ a' <- traverse resolvePathParameters a+ pure (PathSegment i' a' x')++ isParamsForPath :: PathType -> PathParameters a -> Bool+ isParamsForPath t' AngleBracketed{} = t' `elem` ([TypePath, ExprPath] :: [PathType])+ isParamsForPath t' Parenthesized{} = t' `elem` ([TypePath] :: [PathType])++-- | There are three potential instances for resolving a path (depending on what type it is). The+-- 'Resolve' instance for 'Path' will let through any path.+instance (Typeable a, Monoid a) => Resolve (Path a) where+ resolveM = resolvePath TypePath++-- | A path parameter can be invalid if any of its constituent components are invalid+resolvePathParameters :: (Typeable a, Monoid a) => PathParameters a -> ResolveM (PathParameters a)+resolvePathParameters p@(AngleBracketed lts tys bds x) = scope p $ do+ lts' <- traverse resolveLifetime lts+ tys' <- traverse (resolveTy AnyType) tys+ bds' <- traverse (\(i,t) -> (,) <$> resolveIdent i <*> resolveTy NoSumType t) bds+ pure (AngleBracketed lts' tys' bds' x)+resolvePathParameters p@(Parenthesized tys tym x) = scope p $ do+ tys' <- traverse (resolveTy AnyType) tys+ tym' <- traverse (resolveTy NoSumType) tym+ pure (Parenthesized tys' tym' x)++instance (Typeable a, Monoid a) => Resolve (PathParameters a) where resolveM = resolvePathParameters++-- | A QSelf by itself is only invalid when the underlying type is+resolveQSelf :: (Typeable a, Monoid a) => QSelf a -> ResolveM (QSelf a)+resolveQSelf q@(QSelf t p) = scope q (QSelf <$> resolveTy AnyType t <*> pure p)++instance (Typeable a, Monoid a) => Resolve (QSelf a) where resolveM = resolveQSelf+++-----------+-- Types --+-----------++-- | A lifetime can only be invalid if the underlying identifier is. Note that lifetimes cannot use+-- keywords.+resolveLifetime :: Typeable a => Lifetime a -> ResolveM (Lifetime a)+resolveLifetime l@(Lifetime n _)+ | n == "static" = pure l + | n == "_" = pure l + | otherwise = scope l (resolveIdent (mkIdent n) *> pure l)++instance Typeable a => Resolve (Lifetime a) where resolveM = resolveLifetime++-- | A trait ref is invalid if the underlying type path is.+resolveTraitRef :: (Typeable a, Monoid a) => TraitRef a -> ResolveM (TraitRef a)+resolveTraitRef t@(TraitRef p) = scope t (TraitRef <$> resolvePath TypePath p)++instance (Typeable a, Monoid a) => Resolve (TraitRef a) where resolveM = resolveTraitRef++-- | There a a variety of constraints imposed on types, representing different invariants+data TyType+ = AnyType -- ^ No restrictions+ | NoSumType -- ^ Any type except for 'TraitObject' with a '+'+ | PrimParenType -- ^ Types not starting with '<' or '(', or paren types with no sum types inside+ | NoForType -- ^ Non-sum types not starting with a 'for'++-- | Resolve a given type, and a constraint on it (see the parser 'Internal.y' for more details on+-- these cases). +resolveTy :: (Typeable a, Monoid a) => TyType -> Ty a -> ResolveM (Ty a)+-- TraitObject+resolveTy NoSumType o@(TraitObject b _) | length b > 1 = scope o (correct "added parens around trait object type" *> resolveTy NoSumType (ParenTy o mempty))+resolveTy NoForType o@TraitObject{} = scope o (correct "added parens around trait object type" *> resolveTy NoForType (ParenTy o mempty))+resolveTy _ o@(TraitObject bds@(NonEmpty (TraitTyParamBound{} N2.:| _)) x)+ = scope o (TraitObject <$> traverse (resolveTyParamBound ModBound) bds <*> pure x)+resolveTy _ o@TraitObject{} = scope o (err o "first bound in trait object should be a trait bound")+-- ParenTy+resolveTy PrimParenType p@(ParenTy ty' x) = scope p (ParenTy <$> resolveTy NoSumType ty' <*> pure x)+resolveTy _ p@(ParenTy ty' x) = scope p (ParenTy <$> resolveTy AnyType ty' <*> pure x)+-- TupTy+resolveTy PrimParenType t@TupTy{} = scope t (correct "added parens around tuple type" *> resolveTy PrimParenType (ParenTy t mempty))+resolveTy _ t@(TupTy tys x) = scope t (TupTy <$> traverse (resolveTy AnyType) tys <*> pure x)+-- ImplTrait+resolveTy _ i@(ImplTrait bds x) = scope i (ImplTrait <$> traverse (resolveTyParamBound ModBound) bds <*> pure x)+-- PathTy+resolveTy PrimParenType p@(PathTy (Just _) _ _) = scope p (correct "added parents around path type" *> resolveTy PrimParenType (ParenTy p mempty))+resolveTy _ p@(PathTy q p'@(Path _ s _) x) = scope p $+ case q of+ Just (QSelf _ i)+ | 0 <= i && i < length s -> PathTy <$> traverse resolveQSelf q <*> resolvePath TypePath p' <*> pure x+ | otherwise -> err p "index given by QSelf is outside the possible range"+ Nothing -> PathTy Nothing <$> resolvePath TypePath p' <*> pure x +-- BareFn+resolveTy NoForType f@(BareFn _ _ (_:_) _ _) = scope f (correct "added parens around `for' function type" *> resolveTy NoForType (ParenTy f mempty))+resolveTy _ f@(BareFn u a lts fd x) = scope f (BareFn u a <$> traverse resolveLifetimeDef lts <*> resolveFnDecl declTy GeneralArg fd <*> pure x)+ where declTy = if a == C then VarNoSelf else NoSelf+-- Other types (don't care about the context)+resolveTy _ (Never x) = pure (Never x)+resolveTy _ p@(Ptr mut ty' x) = scope p (Ptr mut <$> resolveTy NoSumType ty' <*> pure x)+resolveTy _ r@(Rptr lt mut ty' x) = scope r (Rptr <$> traverse resolveLifetime lt <*> pure mut <*> resolveTy NoSumType ty' <*> pure x)+resolveTy _ t@(Typeof e x) = scope t (Typeof <$> resolveExpr AnyExpr e <*> pure x)+resolveTy _ (Infer x) = pure (Infer x)+resolveTy _ s@(Slice ty' x) = scope s (Slice <$> resolveTy AnyType ty' <*> pure x)+resolveTy _ a@(Array ty' e x) = scope a (Array <$> resolveTy AnyType ty' <*> resolveExpr AnyExpr e <*> pure x)+resolveTy _ m@(MacTy (Mac p t x) x') = scope m $ do+ p' <- resolvePath TypePath p+ MacTy <$> resolveMac TypePath (Mac p' t x) <*> pure x'++instance (Typeable a, Monoid a) => Resolve (Ty a) where resolveM = resolveTy AnyType++-- In some cases, the first argument of a function declaration may be a 'self'+data FnDeclType+ = NoSelf -- ^ the first argument cannot be self+ | VarNoSelf -- ^ the first argument cannot be self, and the function can be variadic+ | AllowSelf -- ^ the first argument can be self+ deriving (Eq)++-- | A function declaration can be invalid if it has self arguments in the wrong places (or when it+-- shouldn't)+resolveFnDecl :: (Typeable a, Monoid a) => FnDeclType -> ArgType -> FnDecl a -> ResolveM (FnDecl a)+resolveFnDecl fn _ f@(FnDecl (s : _) _ _ _) | isSelfArg s && fn /= AllowSelf = scope f (err f "self argument is not allowed in this function declaration")+resolveFnDecl _ _ f@(FnDecl (_ : as) _ _ _) | any isSelfArg as = scope f (err f "self arguments must always be the first arguments")+resolveFnDecl fn _ f@(FnDecl _ _ True _) | fn /= VarNoSelf = scope f (err f "this function declaration cannot be variadic")+resolveFnDecl _ at f@(FnDecl as o v x) = scope f (FnDecl <$> traverse (resolveArg at) as <*> traverse (resolveTy AnyType) o <*> pure v <*> pure x)++-- | Check whether an argument is one of the "self" forms+isSelfArg :: Arg a -> Bool+isSelfArg Arg{} = False+isSelfArg _ = True++instance (Typeable a, Monoid a) => Resolve (FnDecl a) where resolveM = resolveFnDecl AllowSelf NamedArg++-- | Only some type parameter bounds allow trait bounds to start with ?+data TyParamBoundType+ = NoneBound -- ^ Don't allow '? poly_trait_ref'+ | ModBound -- ^ Allow '? poly_trait_ref'++-- | A type parameter bound is invalid if+--+-- * an underlying lifetime or traitref is+-- * it is 'NoneBound' but is a trait bound with a '?' (as in 'ObjectTrait')+--+resolveTyParamBound :: (Typeable a, Monoid a) => TyParamBoundType -> TyParamBound a -> ResolveM (TyParamBound a)+resolveTyParamBound _ b@(RegionTyParamBound lt x) = scope b (RegionTyParamBound <$> resolveLifetime lt <*> pure x)+resolveTyParamBound NoneBound b@(TraitTyParamBound _ Maybe _) = scope b (err b "? trait is not allowed in this type param bound")+resolveTyParamBound _ b@(TraitTyParamBound p t x) = scope b (TraitTyParamBound <$> resolvePolyTraitRef p <*> pure t <*> pure x)++instance (Typeable a, Monoid a) => Resolve (TyParamBound a) where resolveM = resolveTyParamBound ModBound++-- | There are several restricted forms of arguments allowed+data ArgType+ = GeneralArg -- ^ Arguments allowed in places without implementation (optional limited pattern followed by a type)+ | NamedArg -- ^ Arguments allowed in most places (any pattern followed by any type)+ -- This includes lambda arguments++-- | The only types of patterns supported by arguments are wild or identifiers+resolveArg :: (Typeable a, Monoid a) => ArgType -> Arg a -> ResolveM (Arg a)+resolveArg _ s@SelfValue{} = pure s+resolveArg _ a@(SelfRegion lt m x) = scope a (SelfRegion <$> traverse resolveLifetime lt <*> pure m <*> pure x)+resolveArg _ a@(SelfExplicit t m x) = scope a (SelfExplicit <$> resolveTy AnyType t <*> pure m <*> pure x)+resolveArg NamedArg a@(Arg Nothing _ _) = scope a (err a "named arguments must have patterns")+resolveArg NamedArg a@(Arg p t x) = scope a $ do+ when (isSelfAlike a) $+ warn "argument looks like a self argument - did you mean to use 'SelfValue', 'SelfRegion', or 'SelfExplicit'?"++ p' <- traverse resolvePat p+ t' <- resolveTy AnyType t+ pure (Arg p' t' x)++resolveArg GeneralArg a@(Arg p t x) = scope a $ do+ when (isSelfAlike a) $+ warn "argument looks like a self argument - did you mean to use 'SelfValue', 'SelfRegion', or 'SelfExplicit'?"+ + p' <- case p of+ Nothing -> pure Nothing+ Just WildP{} -> traverse resolvePat p+ Just IdentP{} -> traverse resolvePat p+ Just (RefP WildP{} Immutable _) -> traverse resolvePat p+ Just (RefP (IdentP (ByValue Immutable) _ _ _) Immutable _) -> traverse resolvePat p+ Just (RefP (RefP WildP{} Immutable _) Immutable _) -> traverse resolvePat p+ Just (RefP (RefP (IdentP (ByValue Immutable) _ _ _) Immutable _) Immutable _) -> traverse resolvePat p+ _ -> scope p (err p "this pattern is not allowed for this type of argument")+ t' <- resolveTy AnyType t+ pure (Arg p' t' x)++-- | Check whether an argument is one of the "self"-alike forms+isSelfAlike :: Arg a -> Bool+isSelfAlike (Arg Nothing (PathTy Nothing (Path False [PathSegment (Ident (Name "self") False _) Nothing _] _) _) _) = True+isSelfAlike (Arg Nothing (Rptr _ _ (PathTy Nothing (Path False [PathSegment (Ident (Name "self") False _) Nothing _] _) _) _) _) = True+isSelfAlike _ = False++instance (Typeable a, Monoid a) => Resolve (Arg a) where resolveM = resolveArg NamedArg++-- | A Poly trait ref is valid whenever the underlying trait ref is.+resolvePolyTraitRef :: (Typeable a, Monoid a) => PolyTraitRef a -> ResolveM (PolyTraitRef a)+resolvePolyTraitRef p@(PolyTraitRef lts t x) = scope p $ do+ lts' <- traverse resolveLifetimeDef lts+ t' <- resolveTraitRef t+ pure (PolyTraitRef lts' t' x)++instance (Typeable a, Monoid a) => Resolve (PolyTraitRef a) where resolveM = resolvePolyTraitRef++-- | A lifetime def is invalid if it has non-outer attributes +resolveLifetimeDef :: (Typeable a, Monoid a) => LifetimeDef a -> ResolveM (LifetimeDef a)+resolveLifetimeDef lts@(LifetimeDef as l bds x) = scope lts $ do+ as' <- traverse (resolveAttr OuterAttr) as+ l' <- resolveLifetime l+ bds' <- traverse resolveLifetime bds+ pure (LifetimeDef as' l' bds' x)++instance (Typeable a, Monoid a) => Resolve (LifetimeDef a) where resolveM = resolveLifetimeDef+++--------------+-- Patterns --+--------------++-- | A pattern can be invalid of+--+-- * the index of the '...' in the tuple/tuple-struct is out of range+-- * the index of the qself path is out of range+-- * any underlying component is invalid+--+resolvePat :: (Typeable a, Monoid a) => Pat a -> ResolveM (Pat a)+-- TupleStruct+resolvePat t@(TupleStructP p fs im x) = scope t $ do+ p' <- resolvePath ExprPath p+ fs' <- traverse resolvePat fs+ im' <- case im of+ Nothing -> pure Nothing+ Just i | 0 <= i && i <= length fs -> pure (Just i)+ _ -> err im "index of ... in tuple struct pattern is outside of field range"+ pure (TupleStructP p' fs' im' x)+-- PathP+resolvePat p@(PathP Nothing a x) = scope p (PathP Nothing <$> resolvePath ExprPath a <*> pure x)+resolvePat p@(PathP q@(Just (QSelf _ i)) p'@(Path g s x) x')+ | i < 0 || i >= length s = scope p (err p "index given by QSelf is outside the possible range")+ | i == 0 = scope p (PathP <$> traverse resolveQSelf q <*> resolvePath ExprPath p' <*> pure x)+ | otherwise = scope p $ do+ Path _ tyPSegs _ <- resolvePath TypePath $ Path g (take i s) mempty+ Path _ exprPSegs _ <- resolvePath ExprPath $ Path False (drop i s) x+ q' <- traverse resolveQSelf q+ pure (PathP q' (Path g (tyPSegs <> exprPSegs) x) x')+-- TupleP+resolvePat p@(TupleP ps i x) = scope p $ do+ ps' <- traverse resolvePat ps+ i' <- case i of+ Nothing -> pure Nothing+ Just j | 0 <= j && j <= length ps -> pure i+ | otherwise -> err i "index of ... in tuple pattern is outside of range"+ pure (TupleP ps' i' x)++-- Everything else...+resolvePat p@(LitP e x) = scope p (LitP <$> resolveExpr LitExpr e <*> pure x)+resolvePat p@(RangeP l h x) = scope p (RangeP <$> resolveExpr LitOrPathExpr l <*> resolveExpr LitOrPathExpr h <*> pure x)+resolvePat p@(WildP x) = scope p (pure (WildP x))+resolvePat p@(IdentP m i p' x) = scope p (IdentP m <$> resolveIdent i <*> traverse resolvePat p' <*> pure x)+resolvePat p@(StructP p' fs b x) = scope p (StructP <$> resolvePath ExprPath p' <*> traverse resolveFieldPat fs <*> pure b <*> pure x)+resolvePat p@(BoxP p' x) = scope p (BoxP <$> resolvePat p' <*> pure x)+resolvePat p@(RefP p' m x) = scope p (RefP <$> resolvePat p' <*> pure m <*> pure x)+resolvePat p@(SliceP b m a x) = scope p (SliceP <$> traverse resolvePat b <*> traverse resolvePat m <*> traverse resolvePat a <*> pure x)+resolvePat p@(MacP m x) = scope p (MacP <$> resolveMac ExprPath m <*> pure x)++instance (Typeable a, Monoid a) => Resolve (Pat a) where resolveM = resolvePat++-- | Field patterns are only invalid if the underlying pattern / identifier is+resolveFieldPat :: (Typeable a, Monoid a) => FieldPat a -> ResolveM (FieldPat a)+resolveFieldPat f@(FieldPat Nothing p x) = scope f $+ case p of (IdentP _ _ Nothing _) -> FieldPat Nothing <$> resolvePat p <*> pure x+ (BoxP (IdentP _ _ Nothing _) _) -> FieldPat Nothing <$> resolvePat p <*> pure x+ _ -> err f "patterns for fields without an identifier must be (possibly box) identifiers"+resolveFieldPat f@(FieldPat i p x) = scope f (FieldPat <$> traverse resolveIdent i <*> resolvePat p <*> pure x)++instance (Typeable a, Monoid a) => Resolve (FieldPat a) where resolveM = resolveFieldPat+++-----------------+-- Expressions --+-----------------++-- Invariants on expressions+data ExprType+ = AnyExpr -- ^ Any expression, no restrictions+ | LitExpr -- ^ Either an immediate literal, or a negated literal+ | LitOrPathExpr -- ^ A literal, negated literal, expression path, or qualified expression path+ | NoStructExpr -- ^ No struct literals are allowed+ | NoStructBlockExpr -- ^ No struct literals or block expressions (block-like things like 'if' are fine)+ | SemiExpr -- ^ Forbids expressions starting with blocks (things like '{ 1 } + 2') unless+ -- the leading block has a postfix expression, allows expressions that are+ -- just one big block. Forbids '{ 1 }[0]' since it is treated as '{ 1 }; [0]'+ -- and '{ 1 }(0)' since it is treated as '{ 1 }; (0)'+{-+-- Check if an expression has the form of a "postfix" (if that's the case, then you don't worry+-- about what is inside).+--+-- ie: `if i[0] == j[0] { i } else { j } [1]`+lhsSemiExpr :: (Typeable a, Monoid a) => Int -> Expr a -> ResolveM (Expr a)+lhsSemiExpr p t@(Try _ e _) = resolveExprP p AnyExpr + +lhsSemiExpr p (FieldAccess _ e _ _) | isBlockLike e = +lhsSemiExpr p (Try _ e _)+lhsSemiExpr p (Try _ e _)++-}++resolveLhsExprP :: (Typeable a, Monoid a) => Int -> ExprType -> Expr a -> ResolveM (Expr a)+resolveLhsExprP p SemiExpr l@Try{} = resolveExprP p AnyExpr l+resolveLhsExprP p SemiExpr l@FieldAccess{} = resolveExprP p AnyExpr l +resolveLhsExprP p SemiExpr l@MethodCall{} = resolveExprP p AnyExpr l+resolveLhsExprP p SemiExpr l@TupField{} = resolveExprP p AnyExpr l+resolveLhsExprP _ SemiExpr l | isBlockLike l = parenthesize l+resolveLhsExprP p t l = resolveExprP p (lhs t) l+ where+ -- | Given the type of expression, what type of expression is allowed on the LHS+ lhs :: ExprType -> ExprType+ lhs LitExpr = error "literal expressions never have a left hand side"+ lhs LitOrPathExpr = error "literal or path expressions never have a left hand side"+ lhs AnyExpr = AnyExpr+ lhs NoStructExpr = NoStructExpr+ lhs NoStructBlockExpr = NoStructBlockExpr+ lhs SemiExpr = AnyExpr++-- | Given the type of expression, what type of expression is allowed on the RHS+rhs :: ExprType -> ExprType+rhs LitExpr = error "literal expressions never have a right hand side"+rhs LitOrPathExpr = error "literal or path expressions never have a right hand side"+rhs AnyExpr = AnyExpr+rhs NoStructExpr = NoStructExpr+rhs NoStructBlockExpr = NoStructExpr+rhs SemiExpr = AnyExpr++-- | Given the type of expression, what type of expression is allowed on the RHS (after '..'/'...')+rhs2 :: ExprType -> ExprType+rhs2 LitExpr = error "literal expressions never have a right hand side (2)"+rhs2 LitOrPathExpr = error "literal or path expressions never have a right hand side (2)"+rhs2 AnyExpr = AnyExpr+rhs2 NoStructExpr = NoStructBlockExpr+rhs2 NoStructBlockExpr = NoStructBlockExpr+rhs2 SemiExpr = AnyExpr++-- | Resolve an expression of the given type in a general context+resolveExpr :: (Typeable a, Monoid a) => ExprType -> Expr a -> ResolveM (Expr a)+resolveExpr = resolveExprP 0++instance (Typeable a, Monoid a) => Resolve (Expr a) where resolveM = resolveExpr AnyExpr++parenthesize :: (Typeable a, Monoid a) => Expr a -> ResolveM (Expr a)+parenthesize e = do+ correct "added parens around expression"+ e' <- resolveExprP 0 AnyExpr e+ pure (ParenExpr [] e' mempty)++{-+Precedences (from 'Internal.y')+===============================++0 %nonassoc box return break continue LAMBDA+1 %right '=' '>>=' '<<=' '-=' '+=' '*=' '/=' '^=' '|=' '&=' '%='+2 %right '<-'+ %nonassoc SINGLERNG -- '..'+3 %nonassoc INFIXRNG -- e1 '..' e2+4 %nonassoc POSTFIXRNG -- e1 '..'+5 %nonassoc PREFIXRNG -- '..' e2+6 %left '||'+7 %left '&&'+8 %left '==' '!=' '<' '>' '<=' '>='+9 %left '|'+10 %left '^'+11 %left '&'+12 %left '<<' '>>'+13 %left '+' '-'+14 %left '*' '/' '%'+15 %left ':' as+16 %nonassoc UNARY -- 'UNARY' is introduced here for '*', '!', '-', '&'+17 %nonassoc POSTFIX -- 'POSTFIX' is introduced here for things like '?'+-}++-- | This has a double role: to resolve the expression and keep track of precedences+resolveExprP :: (Typeable a, Monoid a) => Int -> ExprType -> Expr a -> ResolveM (Expr a)+-- Cover the 'LitExpr' type of expression+resolveExprP p LitExpr l@Lit{} = resolveExprP p AnyExpr l+resolveExprP p LitExpr n@(Unary _ Neg Lit{} _) = resolveExprP p AnyExpr n+resolveExprP _ LitExpr l = scope l (err l "expression is not literal or negated literal")+-- Cover the 'LitOrPathExpr' type of expression+resolveExprP p LitOrPathExpr l@Lit{} = resolveExprP p AnyExpr l+resolveExprP p LitOrPathExpr n@(Unary _ Neg Lit{} _) = resolveExprP p AnyExpr n+resolveExprP p LitOrPathExpr p'@PathExpr{} = resolveExprP p AnyExpr p'+resolveExprP _ LitOrPathExpr l = scope l (err l "expression is not literal, negated literal, path, or qualified path")+-- The following group of expression variants work in all of the remaining contexts (see+-- 'gen_expression' in the parser)+resolveExprP p c b@(Box as e x) = scope b $ parenE (p > 0) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ e' <- resolveExprP 0 (rhs c) e+ pure (Box as' e' x)+resolveExprP p c r@(Ret as me x) = scope r $ parenE (p > 0) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ me' <- traverse (resolveExprP 0 (rhs c)) me+ pure (Ret as' me' x)+resolveExprP p c r@(Yield as me x) = scope r $ parenE (p > 0) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ me' <- traverse (resolveExprP 0 (rhs c)) me+ pure (Yield as' me' x)+resolveExprP p c b@(Break as ml me x) = scope b $ parenE (p > 0) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ ml' <- traverse resolveLbl ml+ me' <- traverse (resolveExprP 0 (rhs c)) me+ pure (Break as' ml' me' x) +resolveExprP p _ c@(Continue as ml x) = scope c $ parenE (p > 0) $ do + as' <- traverse (resolveAttr OuterAttr) as+ ml' <- traverse resolveLbl ml+ pure (Continue as' ml' x)+-- Closures+resolveExprP _ _ c@(Closure _ _ _ (FnDecl _ _ True _) _ _) = scope c (err c "closures can never be variadic")+resolveExprP p c e@(Closure as m cb fn@(FnDecl _ ret _ _) b x) = scope c $+ case (c, ret, b) of+ (NoStructExpr, Just _, BlockExpr{}) -> parenthesize e+ (NoStructBlockExpr, Just _, BlockExpr{}) -> parenthesize e+ (NoStructExpr, Just _, _ ) -> parenthesize (Closure as m cb fn (asBlock b) x) + (NoStructBlockExpr, Just _, _ ) -> parenthesize (Closure as m cb fn (asBlock b) x)+ (_, Just _, BlockExpr{}) -> resolved AnyExpr+ (_, Just _, _ ) -> parenthesize (Closure as m cb fn (asBlock b) x)+ _ -> resolved (rhs c)+ where+ asBlock ex = BlockExpr [] (Block [NoSemi ex mempty] Normal mempty) mempty++ resolved c' = parenE (p > 0) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ fn' <- resolveFnDecl NoSelf NamedArg fn+ b' <- resolveExprP 0 c' b+ pure (Closure as' m cb fn' b' x)+-- Assignment/in-place expressions+resolveExprP p c a@(Assign as l r x) = scope a $ parenE (p > 1) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --l' <- resolveExprP 2 (lhs c) l+ l' <- resolveLhsExprP 2 c l+ r' <- resolveExprP 1 (rhs c) r+ pure (Assign as' l' r' x)+resolveExprP p c a@(AssignOp as o l r x) = scope a $ parenE (p > 1) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --l' <- resolveExprP 2 (lhs c) l+ l' <- resolveLhsExprP 2 c l+ r' <- resolveExprP 1 (rhs c) r+ pure (AssignOp as' o l' r' x)+resolveExprP p c i@(InPlace as l r x) = scope i $ parenE (p > 2) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --l' <- resolveExprP 3 (lhs c) l + l' <- resolveLhsExprP 3 c l+ r' <- resolveExprP 2 (rhs c) r + pure (InPlace as' l' r' x)+-- Range expressions+resolveExprP _ _ r@(Range _ _ Nothing Closed _) = scope r (err r "inclusive ranges must be bounded at the end")+resolveExprP _ _ r@(Range as Nothing Nothing rl x) = scope r $ do+ as' <- traverse (resolveAttr OuterAttr) as+ pure (Range as' Nothing Nothing rl x)+resolveExprP p c a@(Range as (Just l) (Just r) rl x) = scope a $ parenE (p > 3) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ -- l' <- resolveExprP 4 (lhs c) l+ l' <- resolveLhsExprP 4 c l+ r' <- resolveExprP 4 (rhs2 c) r+ pure (Range as' (Just l') (Just r') rl x)+resolveExprP p c r@(Range as (Just l) Nothing rl x) = scope r $ parenE (p > 4) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ -- l' <- resolveExprP 4 (lhs c) l+ l' <- resolveLhsExprP 4 c l+ pure (Range as' (Just l') Nothing rl x)+resolveExprP p c a@(Range as Nothing (Just r) rl x) = scope a $ parenE (p > 5) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ r' <- resolveExprP 5 (rhs2 c) r+ pure (Range as' Nothing (Just r') rl x)+-- Binary expressions+resolveExprP p c b@(Binary as o l r x) = scope b $ parenE (p > p') $ do+ as' <- traverse (resolveAttr OuterAttr) as+ -- l' <- resolveExprP p' (lhs c) l + l' <- resolveLhsExprP p' c l+ r' <- resolveExprP (p' + 1) (rhs c) r + pure (Binary as' o l' r' x)+ where+ p' = opPrec o++ opPrec :: BinOp -> Int+ opPrec AddOp = 13+ opPrec SubOp = 13+ opPrec MulOp = 14+ opPrec DivOp = 14+ opPrec RemOp = 14+ opPrec AndOp = 7+ opPrec OrOp = 6+ opPrec BitXorOp = 10+ opPrec BitAndOp = 11+ opPrec BitOrOp = 9+ opPrec ShlOp = 12+ opPrec ShrOp = 12+ opPrec EqOp = 8+ opPrec LtOp = 8+ opPrec LeOp = 8+ opPrec NeOp = 8+ opPrec GeOp = 8+ opPrec GtOp = 8+-- Cast and type ascriptions expressions+resolveExprP p c a@(Cast as e t x) = scope a $ parenE (p > 15) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --e' <- resolveExprP 15 (lhs c) e+ e' <- resolveLhsExprP 15 c e+ t' <- resolveTy NoSumType t+ pure (Cast as' e' t' x)+resolveExprP p c a@(TypeAscription as e t x) = scope a $ parenE (p > 15) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --e' <- resolveExprP 15 (lhs c) e+ e' <- resolveLhsExprP 15 c e+ t' <- resolveTy NoSumType t+ pure (TypeAscription as' e' t' x)+-- Unary expressions+resolveExprP p c u@(Unary as o e x) = scope u $ parenE (p > 16) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ e' <- resolveExprP 16 (rhs c) e+ pure (Unary as' o e' x)+resolveExprP p c a@(AddrOf as m e x) = scope a $ parenE (p > 16) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ e' <- resolveExprP 16 (rhs c) e+ pure (AddrOf as' m e' x)+-- Postfix expressions+resolveExprP p c a@(Index as e i x) = scope a $ parenE (p > 17) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --e' <- resolveExprP 17 (lhs c) e+ e' <- resolveLhsExprP 17 c e+ i' <- resolveExprP 0 AnyExpr i+ pure (Index as' e' i' x)+resolveExprP p SemiExpr t@Try{} = resolveExprP p AnyExpr t+resolveExprP p c t@(Try as e x) = scope t $ parenE (p > 17) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --e' <- resolveExprP 17 (lhs c) e+ e' <- resolveLhsExprP 17 c e+ pure (Try as' e' x) +resolveExprP p c a@(Call as f xs x) = scope a $ parenE (p > 17) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --f' <- resolveExprP 17 (lhs c) f+ f' <- resolveLhsExprP 17 c f+ xs' <- traverse (resolveExprP 0 AnyExpr) xs+ pure (Call as' f' xs' x)+resolveExprP p SemiExpr m@MethodCall{} = resolveExprP p AnyExpr m+resolveExprP p c m@(MethodCall as e i mt es x) = scope m $ parenE (p > 17) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --e' <- resolveExprP 17 (lhs c) e+ e' <- resolveLhsExprP 17 c e+ i' <- resolveIdent i+ mt' <- case mt of+ Just t -> Just <$> traverse (resolveTy AnyType) t+ Nothing -> pure Nothing+ es' <- traverse (resolveExprP 0 AnyExpr) es+ pure (MethodCall as' e' i' mt' es' x)+resolveExprP p SemiExpr t@TupField{} = resolveExprP p AnyExpr t+resolveExprP p c t@(TupField as e i x) = scope t $ parenE (p > 17) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --e' <- resolveExprP 17 (lhs c) e+ e' <- resolveLhsExprP 17 c e+ pure (TupField as' e' i x)+resolveExprP p SemiExpr f@FieldAccess{} = resolveExprP p AnyExpr f+resolveExprP p c f@(FieldAccess as e i x) = scope f $ parenE (p > 17) $ do+ as' <- traverse (resolveAttr OuterAttr) as+ --e' <- resolveExprP 17 (lhs c) e+ e' <- resolveLhsExprP 17 c e+ i' <- resolveIdent i+ pure (FieldAccess as' e' i' x)+-- Immediate expressions+resolveExprP _ _ v@(Vec as es x) = scope v $ do+ as' <- traverse (resolveAttr EitherAttr) as+ es' <- traverse (resolveExprP 0 AnyExpr) es+ pure (Vec as' es' x) +resolveExprP _ _ p@(PathExpr as Nothing p' x) = scope p $ do+ as' <- traverse (resolveAttr OuterAttr) as+ p'' <- resolvePath ExprPath p'+ pure (PathExpr as' Nothing p'' x)+resolveExprP _ _ p@(PathExpr as q@(Just (QSelf _ i)) p'@(Path g s x) x')+ | i < 0 || i >= length s = scope p (err p "index given by QSelf is outside the possible range")+ | i == 0 = scope p $ do+ as' <- traverse (resolveAttr OuterAttr) as+ q' <- traverse resolveQSelf q+ p'' <- resolvePath ExprPath p'+ pure (PathExpr as' q' p'' x)+ | otherwise = scope p $ do+ as' <- traverse (resolveAttr OuterAttr) as+ Path _ tyPSegs _ <- resolvePath TypePath $ Path g (take i s) mempty+ Path _ exprPSegs _ <- resolvePath ExprPath $ Path False (drop i s) x+ q' <- traverse resolveQSelf q+ pure (PathExpr as' q' (Path g (tyPSegs <> exprPSegs) x) x') +resolveExprP _ _ i@(Lit as l x) = scope i $ do+ as' <- traverse (resolveAttr OuterAttr) as+ l' <- resolveLit l+ pure (Lit as' l' x)+resolveExprP _ _ a@(Repeat as e r x) = scope a $ do+ as' <- traverse (resolveAttr OuterAttr) as+ e' <- resolveExprP 0 AnyExpr e+ r' <- resolveExprP 0 AnyExpr r+ pure (Repeat as' e' r' x)+-- Macro expressions+resolveExprP _ _ a@(MacExpr as m x) = scope a $ do+ as' <- traverse (resolveAttr OuterAttr) as+ m' <- resolveMac ExprPath m+ pure (MacExpr as' m' x)+-- Paren expressions+resolveExprP _ _ p@(ParenExpr as e x) = scope p $ do+ as' <- traverse (resolveAttr EitherAttr) as+ e' <- resolveExprP 0 AnyExpr e+ pure (ParenExpr as' e' x)+resolveExprP _ _ t@(TupExpr as es x) = scope t $ do+ as' <- traverse (resolveAttr EitherAttr) as+ es' <- traverse (resolveExprP 0 AnyExpr) es+ pure (TupExpr as' es' x)+-- Block expressions+resolveExprP _ NoStructBlockExpr e@BlockExpr{} = parenthesize e+resolveExprP _ _ l@(BlockExpr as b x) = scope l $ do+ as' <- traverse (resolveAttr EitherAttr) as+ b' <- resolveBlock b+ pure (BlockExpr as' b' x) +-- Struct expressions+resolveExprP _ NoStructExpr e@Struct{} = parenthesize e+resolveExprP _ NoStructBlockExpr e@Struct{} = parenthesize e+resolveExprP _ _ s@(Struct as p' fs e x) = scope s $ do+ as' <- traverse (resolveAttr OuterAttr) as+ p'' <- resolvePath ExprPath p'+ fs' <- traverse resolveField fs+ e' <- traverse (resolveExprP 0 AnyExpr) e+ pure (Struct as' p'' fs' e' x)+-- Block-like expressions+resolveExprP p c i@(If as e b es x) = scope i $ do+ as' <- traverse (resolveAttr OuterAttr) as+ e' <- resolveExprP 0 NoStructExpr e+ b' <- resolveBlock b+ es' <- case es of+ Nothing -> pure Nothing+ (Just If{}) -> traverse (resolveExprP p c) es+ (Just IfLet{}) -> traverse (resolveExprP p c) es+ (Just BlockExpr{}) -> traverse (resolveExprP p c) es+ (Just e'') -> Just <$> resolveExprP p c (BlockExpr [] (Block [NoSemi e'' mempty] Normal mempty) mempty)+ pure (If as' e' b' es' x)+resolveExprP p c i@(IfLet as p' e b es x) = scope i $ do+ as' <- traverse (resolveAttr OuterAttr) as+ p'' <- traverse resolvePat p'+ e' <- resolveExprP 0 NoStructExpr e+ b' <- resolveBlock b+ es' <- case es of+ Nothing -> pure Nothing+ (Just If{}) -> traverse (resolveExprP p c) es+ (Just IfLet{}) -> traverse (resolveExprP p c) es+ (Just BlockExpr{}) -> traverse (resolveExprP p c) es+ (Just e'') -> Just <$> resolveExprP p c (BlockExpr [] (Block [NoSemi e'' mempty] Normal mempty) mempty)+ pure (IfLet as' p'' e' b' es' x)+resolveExprP _ _ w@(While as e b l x) = scope w $ do+ as' <- traverse (resolveAttr EitherAttr) as+ e' <- resolveExprP 0 NoStructExpr e+ b' <- resolveBlock b+ l' <- traverse resolveLbl l+ pure (While as' e' b' l' x)+resolveExprP _ _ w@(WhileLet as p' e b l x) = scope w $ do+ as' <- traverse (resolveAttr EitherAttr) as+ p'' <- traverse resolvePat p'+ e' <- resolveExprP 0 NoStructExpr e+ b' <- resolveBlock b+ l' <- traverse resolveLbl l+ pure (WhileLet as' p'' e' b' l' x)+resolveExprP _ _ f@(ForLoop as p' e b l x) = scope f $ do+ as' <- traverse (resolveAttr EitherAttr) as+ p'' <- resolvePat p'+ e' <- resolveExprP 0 NoStructExpr e+ b' <- resolveBlock b+ l' <- traverse resolveLbl l+ pure (ForLoop as' p'' e' b' l' x)+resolveExprP _ _ o@(Loop as b l x) = scope o $ do+ as' <- traverse (resolveAttr EitherAttr) as+ b' <- resolveBlock b+ l' <- traverse resolveLbl l+ pure (Loop as' b' l' x)+resolveExprP _ _ m@(Match as e ar x) = scope m $ do+ as' <- traverse (resolveAttr EitherAttr) as+ e' <- resolveExprP 0 AnyExpr e+ ar' <- traverse resolveArm ar+ pure (Match as' e' ar' x)+resolveExprP _ _ c@(Catch as b x) = scope c $ do+ as' <- traverse (resolveAttr EitherAttr) as+ b' <- resolveBlock b+ pure (Catch as' b' x) +resolveExprP _ _ e@(EmbeddedExpr as code x) = scope e $ do+ as' <- traverse (resolveAttr EitherAttr) as+ pure (EmbeddedExpr as' code x)++isBlockLike :: Expr a -> Bool+isBlockLike If{} = True+isBlockLike IfLet{} = True+isBlockLike Loop{} = True+isBlockLike ForLoop{} = True+isBlockLike While{} = True+isBlockLike WhileLet{} = True+isBlockLike Match{} = True+isBlockLike BlockExpr{} = True+isBlockLike _ = False++resolveLbl :: Typeable a => Label a -> ResolveM (Label a)+resolveLbl l@(Label n _) = scope l (resolveIdent (mkIdent n) *> pure l)++-- | Wrap an expression in parens if the condition given holds+parenE :: (Typeable a, Monoid a) => Bool -> ResolveM (Expr a) -> ResolveM (Expr a)+parenE True e = ParenExpr [] <$> e <*> pure mempty+parenE False e = e++-- | A field just requires the identifier and expression to be valid+resolveField :: (Typeable a, Monoid a) => Field a -> ResolveM (Field a)+resolveField f@(Field i e x) = scope f $ do+ i' <- resolveIdent i+ e' <- traverse (resolveExpr AnyExpr) e+ pure (Field i' e' x)++instance (Typeable a, Monoid a) => Resolve (Field a) where resolveM = resolveField++-- | Arms are invalid only if the underlying consitutents are+resolveArm :: (Typeable a, Monoid a) => Arm a -> ResolveM (Arm a)+resolveArm a@(Arm as ps g b x) = scope a $ do+ as' <- traverse (resolveAttr OuterAttr) as+ ps' <- traverse resolvePat ps+ g' <- traverse (resolveExpr AnyExpr) g+ b' <- resolveExpr SemiExpr b+ pure (Arm as' ps' g' b' x)++instance (Typeable a, Monoid a) => Resolve (Arm a) where resolveM = resolveArm+++----------------+-- Statements --+----------------++-- Invariants on statements+data StmtType+ = TermStmt -- ^ require a statement be terminated (so another statement can follow it)?+ | AnyStmt -- ^ any statement++-- | Statements are invalid only when the underlying components are.+resolveStmt :: (Typeable a, Monoid a) => StmtType -> Stmt a -> ResolveM (Stmt a)+resolveStmt _ l@(Local p t i as x) = scope l $ do+ p' <- resolvePat p+ t' <- traverse (resolveTy AnyType) t+ i' <- traverse (resolveExpr AnyExpr) i+ as' <- traverse (resolveAttr OuterAttr) as+ pure (Local p' t' i' as' x)+resolveStmt _ s@(ItemStmt i x) = scope s (ItemStmt <$> resolveItem StmtItem i <*> pure x)+resolveStmt _ s@(Semi e x) | isBlockLike e = scope s (Semi <$> resolveExpr AnyExpr e <*> pure x)+resolveStmt _ s@(Semi e x) = scope s (Semi <$> resolveExpr SemiExpr e <*> pure x)+resolveStmt _ n@(NoSemi e x) | isBlockLike e = scope n (NoSemi <$> resolveExpr AnyExpr e <*> pure x)+resolveStmt AnyStmt n@(NoSemi e x) = scope n (NoSemi <$> resolveExpr SemiExpr e <*> pure x)+resolveStmt TermStmt n@(NoSemi e x) = scope n (NoSemi <$> resolveExpr AnyExpr (BlockExpr [] (Block [NoSemi e mempty] Normal mempty) mempty) <*> pure x)+resolveStmt _ a@(MacStmt m s as x) = scope a $ do+ m' <- resolveMac ExprPath m+ as' <- traverse (resolveAttr OuterAttr) as+ pure (MacStmt m' s as' x)++instance (Typeable a, Monoid a) => Resolve (Stmt a) where resolveM = resolveStmt AnyStmt++-- | A block must a a series of terminated statements ended by one possibly unterminated one+resolveBlock :: (Typeable a, Monoid a) => Block a -> ResolveM (Block a)+resolveBlock b@(Block [] _ _) = pure b+resolveBlock b@(Block (s:ss) r x) = scope b $ do+ ss' <- traverse (resolveStmt TermStmt) (N.init $ NonEmpty (s N2.:| ss))+ s' <- resolveStmt AnyStmt (N.last $ NonEmpty (s N2.:| ss))+ pure (Block (ss' ++ [s']) r x)++instance (Typeable a, Monoid a) => Resolve (Block a) where resolveM = resolveBlock+++-----------+-- Items --+-----------++-- Whether the item is a statement item, or a general item+data ItemType+ = StmtItem -- ^ Corresponds to 'stmt_item' - basically limited visbility and no macros+ | ModItem -- ^ General item++resolveVisibility' :: Typeable a => ItemType -> Visibility a -> ResolveM (Visibility a)+resolveVisibility' StmtItem PublicV = pure PublicV+resolveVisibility' StmtItem InheritedV = pure InheritedV+resolveVisibility' StmtItem v = scope v $ err v "statement items can only have public or inherited visibility"+resolveVisibility' ModItem v = pure v++-- | An item can be invalid if+--+-- * it is a macro but has 'StmtItem' restriction+-- * it has visibility other than public/inherited but has 'StmtItem' restriction+-- * an underlying component is invalid+--+resolveItem :: (Typeable a, Monoid a) => ItemType -> Item a -> ResolveM (Item a)+resolveItem t e@(ExternCrate as v i r x) = scope e $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ r' <- traverse resolveIdent r+ pure (ExternCrate as' v' i' r' x)++resolveItem t u@(Use as v p x) = scope u $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ p' <- resolveUseTree p+ pure (Use as' v' p' x)++resolveItem t s@(Static as v i t' m e x) = scope s $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ t'' <- resolveTy AnyType t'+ e' <- resolveExpr AnyExpr e+ pure (Static as' v' i' t'' m e' x)++resolveItem t c@(ConstItem as v i t' e x) = scope c $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ t'' <- resolveTy AnyType t'+ e' <- resolveExpr AnyExpr e+ pure (ConstItem as' v' i' t'' e' x)++resolveItem t f@(Fn as v i d u c a g b x) = scope f $ do+ as' <- traverse (resolveAttr EitherAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ d' <- resolveFnDecl NoSelf NamedArg d+ g' <- resolveGenerics g+ b' <- resolveBlock b+ pure (Fn as' v' i' d' u c a g' b' x)++resolveItem t m@(Mod as v i (Just is) x) = scope m $ do+ as' <- traverse (resolveAttr EitherAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ is' <- traverse (resolveItem ModItem) is+ pure (Mod as' v' i' (Just is') x)++resolveItem t m@(Mod as v i Nothing x) = scope m $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ pure (Mod as' v' i' Nothing x)++resolveItem t m@(ForeignMod as v a is x) = scope m $ do+ as' <- traverse (resolveAttr EitherAttr) as+ v' <- resolveVisibility' t v+ is' <- traverse (resolveForeignItem a) is+ pure (ForeignMod as' v' a is' x)++resolveItem t a@(TyAlias as v i t' g x) = scope a $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ t'' <- resolveTy AnyType t'+ g' <- resolveGenerics g+ pure (TyAlias as' v' i' t'' g' x)++resolveItem t e@(Enum as v i vs g x) = scope e $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ vs' <- traverse resolveVariant vs+ g' <- resolveGenerics g+ pure (Enum as' v' i' vs' g' x)+ +resolveItem t s@(StructItem as v i vd g x) = scope s $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ vd' <- resolveVariantData vd+ g' <- resolveGenerics g+ pure (StructItem as' v' i' vd' g' x)++resolveItem t u@(Union as v i vd g x) = scope u $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ vd' <- resolveVariantData vd+ g' <- resolveGenerics g+ pure (Union as' v' i' vd' g' x)++resolveItem t r@(Trait as v i a u g bd is x) = scope r $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ g' <- resolveGenerics g+ bd' <- traverse (resolveTyParamBound NoneBound) bd+ is' <- traverse resolveTraitItem is+ pure (Trait as' v' i' a u g' bd' is' x)++resolveItem t r@(TraitAlias as v i g bd x) = scope r $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility' t v+ i' <- resolveIdent i+ g' <- resolveGenerics g+ bd' <- traverse (resolveTyParamBound NoneBound) bd+ pure (TraitAlias as' v' i' g' bd' x)++resolveItem t i'@(Impl as v d u i g mt t' is x) = scope i' $ do+ as' <- traverse (resolveAttr EitherAttr) as+ v' <- resolveVisibility' t v+ g' <- resolveGenerics g+ mt' <- traverse resolveTraitRef mt+ t'' <- case mt of+ Nothing -> resolveTy PrimParenType t'+ Just _ -> resolveTy AnyType t'+ is' <- traverse resolveImplItem is+ pure (Impl as' v' d u i g' mt' t'' is' x)++resolveItem StmtItem m@MacItem{} = scope m (err m "macro items cannot be in statement items")+resolveItem _ a@(MacItem as i m x) = scope a $ do+ as' <- traverse (resolveAttr OuterAttr) as+ i' <- traverse resolveIdent i+ m' <- resolveMac ExprPath m+ pure (MacItem as' i' m' x)++resolveItem _ m@(MacroDef as i ts x) = scope m $ do+ as' <- traverse (resolveAttr OuterAttr) as+ i' <- resolveIdent i+ ts' <- resolveTokenStream ts+ pure (MacroDef as' i' ts' x)++instance (Typeable a, Monoid a) => Resolve (Item a) where resolveM = resolveItem ModItem++-- | A foreign item is invalid only if any of its underlying constituents are +resolveForeignItem :: (Typeable a, Monoid a) => Abi -> ForeignItem a -> ResolveM (ForeignItem a)+resolveForeignItem a f@(ForeignFn as v i fn g x) = scope f $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility v+ i' <- resolveIdent i+ fn' <- resolveFnDecl (case a of { C -> VarNoSelf; _ -> NoSelf }) NamedArg fn+ g' <- resolveGenerics g+ pure (ForeignFn as' v' i' fn' g' x)+resolveForeignItem _ f@(ForeignStatic as v i t m x) = scope f $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility v+ i' <- resolveIdent i+ t' <- resolveTy AnyType t+ pure (ForeignStatic as' v' i' t' m x)+resolveForeignItem _ f@(ForeignTy as v i x) = scope f $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility v+ i' <- resolveIdent i+ pure (ForeignTy as' v' i' x)++instance (Typeable a, Monoid a) => Resolve (ForeignItem a) where resolveM = resolveForeignItem C++-- | A where clause is valid only if the underlying predicates are+resolveWhereClause :: (Typeable a, Monoid a) => WhereClause a -> ResolveM (WhereClause a)+resolveWhereClause w@(WhereClause p x) = scope w (WhereClause <$> traverse resolveWherePredicate p <*> pure x)++instance (Typeable a, Monoid a) => Resolve (WhereClause a) where resolveM = resolveWhereClause++-- | Generics are only invalid if the underlying lifetimes or type parameters are+resolveGenerics :: (Typeable a, Monoid a) => Generics a -> ResolveM (Generics a)+resolveGenerics g@(Generics lts typ wc x) = scope g $ do+ lts' <- traverse resolveLifetimeDef lts+ typ' <- traverse resolveTyParam typ+ wc' <- resolveWhereClause wc+ pure (Generics lts' typ' wc' x)++instance (Typeable a, Monoid a) => Resolve (Generics a) where resolveM = resolveGenerics++-- | A type parameter is invalid only when the underlying components are+resolveTyParam :: (Typeable a, Monoid a) => TyParam a -> ResolveM (TyParam a)+resolveTyParam p@(TyParam as i bds t x) = scope p $ do+ as' <- traverse (resolveAttr OuterAttr) as+ i' <- resolveIdent i+ bds' <- traverse (resolveTyParamBound ModBound) bds+ t' <- traverse (resolveTy AnyType) t+ pure (TyParam as' i' bds' t' x)++instance (Typeable a, Monoid a) => Resolve (TyParam a) where resolveM = resolveTyParam++-- Invariants for struct fields+data StructFieldType+ = IdentStructField -- ^ struct style field+ | BareStructField -- ^ tuple-struct style field++-- | A variant is valid if the underlying components are+resolveVariant :: (Typeable a, Monoid a) => Variant a -> ResolveM (Variant a)+resolveVariant v@(Variant i as n e x) = scope v $ do+ i' <- resolveIdent i+ as' <- traverse (resolveAttr OuterAttr) as+ n' <- resolveVariantData n+ e' <- traverse (resolveExpr AnyExpr) e+ pure (Variant i' as' n' e' x)++instance (Typeable a, Monoid a) => Resolve (Variant a) where resolveM = resolveVariant++-- | A variant data is valid if the underlying components are+resolveVariantData :: (Typeable a, Monoid a) => VariantData a -> ResolveM (VariantData a)+resolveVariantData v@(StructD fs x) = scope v (StructD <$> traverse (resolveStructField IdentStructField) fs <*> pure x)+resolveVariantData v@(TupleD fs x) = scope v (TupleD <$> traverse (resolveStructField BareStructField) fs <*> pure x)+resolveVariantData (UnitD x) = pure (UnitD x)++instance (Typeable a, Monoid a) => Resolve (VariantData a) where resolveM = resolveVariantData++-- | A struct field is invalid if+--+-- * it has the invariant that it needs an identifier, but it doesn't have one+-- * it has the invariant that should not have an identifier, but it doe have one+-- * any of the underlying components are invalid+--+resolveStructField :: (Typeable a, Monoid a) => StructFieldType -> StructField a -> ResolveM (StructField a)+resolveStructField IdentStructField s@(StructField Nothing _ _ _ _) = scope s $ err s "struct field needs an identifier"+resolveStructField IdentStructField s@(StructField (Just i) v t as x) = scope s $ do+ i' <- resolveIdent i+ v' <- resolveVisibility v+ t' <- resolveTy AnyType t+ as' <- traverse (resolveAttr OuterAttr) as+ pure (StructField (Just i') v' t' as' x)+resolveStructField BareStructField s@(StructField (Just _) _ _ _ _) = scope s $ err s "tuple-struct field cannot have an identifier"+resolveStructField BareStructField s@(StructField Nothing v t as x) = scope s $ do+ v' <- resolveVisibility v+ t' <- resolveTy AnyType t+ as' <- traverse (resolveAttr OuterAttr) as+ pure (StructField Nothing v' t' as' x)++instance (Typeable a, Monoid a) => Resolve (StructField a) where resolveM = resolveStructField IdentStructField++-- | A where predicate is invalid only if the underlying lifetimes are+resolveWherePredicate :: (Typeable a, Monoid a) => WherePredicate a -> ResolveM (WherePredicate a)+resolveWherePredicate p@(EqPredicate t1 t2 x) = scope p (EqPredicate <$> resolveTy NoForType t1 <*> resolveTy AnyType t2 <*> pure x)+resolveWherePredicate p@(RegionPredicate l ls x) = scope p $ do+ l' <- resolveLifetime l+ ls' <- traverse resolveLifetime ls+ pure (RegionPredicate l' ls' x)+resolveWherePredicate p@(BoundPredicate lts t bds x) = scope p $ do+ lts' <- traverse resolveLifetimeDef lts+ t' <- resolveTy NoForType t+ bds' <- traverse (resolveTyParamBound ModBound) bds+ pure (BoundPredicate lts' t' bds' x)++instance (Typeable a, Monoid a) => Resolve (WherePredicate a) where resolveM = resolveWherePredicate++-- | A trait item is valid if the underlying components are+resolveTraitItem :: (Typeable a, Monoid a) => TraitItem a -> ResolveM (TraitItem a)+resolveTraitItem n@(ConstT as i t e x) = scope n $ do+ as' <- traverse (resolveAttr OuterAttr) as+ i' <- resolveIdent i+ t' <- resolveTy AnyType t+ e' <- traverse (resolveExpr AnyExpr) e+ pure (ConstT as' i' t' e' x)+resolveTraitItem n@(MethodT as i g m b x) = scope n $ do+ as' <- traverse (resolveAttr OuterAttr) as+ i' <- resolveIdent i+ g' <- resolveGenerics g+ m' <- resolveMethodSig GeneralArg m + b' <- traverse resolveBlock b+ pure (MethodT as' i' g' m' b' x)+resolveTraitItem n@(TypeT as i bd t x) = scope n $ do+ as' <- traverse (resolveAttr OuterAttr) as+ i' <- resolveIdent i+ bd' <- traverse (resolveTyParamBound ModBound) bd+ t' <- traverse (resolveTy AnyType) t+ pure (TypeT as' i' bd' t' x)+resolveTraitItem n@(MacroT as m x) = scope n $ do+ as' <- traverse (resolveAttr OuterAttr) as+ m' <- resolveMac ModPath m+ pure (MacroT as' m' x)++instance (Typeable a, Monoid a) => Resolve (TraitItem a) where resolveM = resolveTraitItem++-- | An impl item is valid if the underlying components are+resolveImplItem :: (Typeable a, Monoid a) => ImplItem a -> ResolveM (ImplItem a)+resolveImplItem n@(ConstI as v d i t e x) = scope n $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility v+ i' <- resolveIdent i+ t' <- resolveTy AnyType t+ e' <- resolveExpr AnyExpr e+ pure (ConstI as' v' d i' t' e' x)+resolveImplItem n@(MethodI as v d i g m b x) = scope n $ do+ as' <- traverse (resolveAttr EitherAttr) as+ v' <- resolveVisibility v+ i' <- resolveIdent i+ g' <- resolveGenerics g+ m' <- resolveMethodSig NamedArg m + b' <- resolveBlock b+ pure (MethodI as' v' d i' g' m' b' x)+resolveImplItem n@(TypeI as v d i t x) = scope n $ do+ as' <- traverse (resolveAttr OuterAttr) as+ v' <- resolveVisibility v+ i' <- resolveIdent i+ t' <- resolveTy AnyType t+ pure (TypeI as' v' d i' t' x)+resolveImplItem n@(MacroI as d m x) = scope n $ do+ as' <- traverse (resolveAttr OuterAttr) as+ m' <- resolveMac ModPath m+ pure (MacroI as' d m' x)++instance (Typeable a, Monoid a) => Resolve (ImplItem a) where resolveM = resolveImplItem++-- | The 'Monoid' constraint is theoretically not necessary - restricted visibility paths are mod paths,+-- so they should never have generics.+resolveVisibility :: (Typeable a, Monoid a) => Visibility a -> ResolveM (Visibility a)+resolveVisibility PublicV = pure PublicV+resolveVisibility InheritedV = pure InheritedV+resolveVisibility CrateV = pure CrateV+resolveVisibility v@(RestrictedV p) = scope v (RestrictedV <$> resolvePath ModPath p)++instance (Typeable a, Monoid a) => Resolve (Visibility a) where resolveM = resolveVisibility++-- | A method signature is valid if the underlying components are+resolveMethodSig :: (Typeable a, Monoid a) => ArgType -> MethodSig a -> ResolveM (MethodSig a)+resolveMethodSig at m@(MethodSig u c a f) = scope m (MethodSig u c a <$> resolveFnDecl AllowSelf at f)++instance (Typeable a, Monoid a) => Resolve (MethodSig a) where resolveM = resolveMethodSig NamedArg++-- | A view path is valid if the underlying components are+resolveUseTree :: (Typeable a, Monoid a) => UseTree a -> ResolveM (UseTree a)+resolveUseTree v@(UseTreeSimple p i x) = scope v $ do+ p' <- resolvePath ModPath p + i' <- traverse resolveIdent i+ pure (UseTreeSimple p' i' x)+resolveUseTree v@(UseTreeGlob p x) = scope v $ do+ p' <- resolvePath UsePath p + pure (UseTreeGlob p' x) +resolveUseTree v@(UseTreeNested p ns x) = scope v $ do+ p' <- resolvePath UsePath p+ ns' <- traverse resolveUseTree ns+ pure (UseTreeNested p' ns' x)++instance (Typeable a, Monoid a) => Resolve (UseTree a) where resolveM = resolveUseTree+++-------------------+-- Macro related --+-------------------++-- | A macro call is only invalid if any of the underlying components are+resolveMac :: (Typeable a, Monoid a) => PathType -> Mac a -> ResolveM (Mac a)+resolveMac t m@(Mac p ts x) = scope m (Mac <$> resolvePath t p <*> resolveTokenStream ts <*> pure x)++instance (Typeable a, Monoid a) => Resolve (Mac a) where+ resolveM m@(Mac p ts x) = scope m (Mac <$> resolveM p <*> resolveTokenStream ts <*> pure x) ++-- | A token tree is invalid when+--+-- * there is an open or close delim token (those should be balanced and in 'Delimited')+-- * the underlying token trees are invalid+--+resolveTt :: TokenTree -> ResolveM TokenTree+resolveTt t@(Token _ (OpenDelim _)) = scope t (err t "open delimiter is not allowed as a token in a token tree")+resolveTt t@(Token _ (CloseDelim _)) = scope t (err t "close delimiter is not allowed as a token in a token tree")+resolveTt t@Token{} = pure t+resolveTt t@(Delimited s d ts) = scope t (Delimited s d <$> resolveTokenStream ts)++instance Resolve TokenTree where resolveM = resolveTt++resolveTokenStream :: TokenStream -> ResolveM TokenStream+resolveTokenStream s@(Tree tt) = scope s (Tree <$> resolveTt tt)+resolveTokenStream s@(Stream ts) = scope s (Stream <$> mapM resolveTokenStream ts)++instance Resolve TokenStream where resolveM = resolveTokenStream+
+ src/Language/Rust/Pretty/Util.hs view
@@ -0,0 +1,161 @@+{-|+Module : Language.Rust.Pretty.Util+Description : pretty printing utilities+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : portable++This module contains a variety of utility functions for pretty printing. Most of these require+inspecting the internal structure of 'Doc'.++Wadler's take on pretty printing is super useful because it allows us to print thinks like blocks+much more nicely (see [this](http://stackoverflow.com/a/41424946/3072788)) that Hughes'.+Unfortunately, unlike Hughes', Wadler does not have 'mempty' as the identity of @<+>@ - the+space between the arguments of @<+>@ does not go away even if either argument is empty. The+same problem shows up for @hsep@, @<#>@, @vsep@, @</>@, etc.++My solution has been to redefine my versions of these functions which _do_ treat 'mempty' as a+neutral element for @<+>@, @hsep@, @<#>@, @vsep@, and @</>@.+-}+{-# LANGUAGE OverloadedStrings #-}++module Language.Rust.Pretty.Util where++import Data.Monoid as M++import qualified Data.Text.Prettyprint.Doc as PP+import Data.Text.Prettyprint.Doc.Internal.Type ( Doc(..) )++import Language.Rust.Syntax.Token ( Delim(..) )++-- | Indentation level+n :: Int+n = 2++-- | Similar to 'maybe', but where the 'Nothing' case is an empty 'Doc'+emptyElim :: Doc a -- ^ result if scrutinee is empty+ -> (Doc a -> Doc a) -- ^ how to process scrutinee if it is not empty+ -> Doc a -- ^ scrutinee 'Doc'+ -> Doc a+emptyElim a _ Empty = a+emptyElim _ f doc = f doc++-- | Vertically concatenate two 'Doc's with a collapsible line between them+(<##>) :: Doc a -> Doc a -> Doc a+d1 <##> d2 = d1 M.<> PP.line' M.<> d2++-- | Flatten a 'Doc'+flatten :: Doc a -> Doc a+flatten d@Fail{} = d+flatten d@Empty{} = d +flatten d@Char{} = d +flatten d@Text{} = d +flatten d@Line{} = d +flatten (FlatAlt _ d) = d+flatten (Cat d1 d2) = Cat (flatten d1) (flatten d2)+flatten (Nest i d) = Nest i (flatten d)+flatten (Union d _) = flatten d+flatten (Column f) = Column (flatten . f)+flatten (WithPageWidth f) = WithPageWidth (flatten . f)+flatten (Nesting f) = Nesting (flatten . f)+flatten (Annotated a d) = Annotated a (flatten d)++-- | Map the list of items into 'Doc's using the provided function and add comma punctuation+commas :: [a] -> (a -> Doc b) -> Doc b+commas xs f = PP.hsep (PP.punctuate "," (map f xs))++-- | Take a binary operation on docs and lift it to one that has (left and right) identity 'mempty'+liftOp :: (Doc a -> Doc a -> Doc a) -> Doc a -> Doc a -> Doc a+liftOp _ Empty d = d+liftOp _ d Empty = d+liftOp (#) d d' = d # d'++-- | Lifted version of Wadler's @<+>@+(<+>) :: Doc a -> Doc a -> Doc a+(<+>) = liftOp (PP.<+>)++-- | Lifted version of Wadler's @hsep@+hsep :: Foldable f => f (Doc a) -> Doc a+hsep = foldr (<+>) mempty++-- | Lifted version of Wadler's @<#>@+(<#>) :: Doc a -> Doc a -> Doc a+(<#>) = liftOp (\x y -> x <> PP.line <> y)++-- | Lifted version of Wadler's @vsep@+vsep :: Foldable f => f (Doc a) -> Doc a+vsep = foldr (<#>) mempty++-- | Lifted version of Wadler's @</>@+(</>) :: Doc a -> Doc a -> Doc a+(</>) = liftOp (\x y -> x <> PP.softline <> y)++-- | Unless the condition holds, print the document+unless :: Bool -> Doc a -> Doc a+unless b = when (not b)++-- | When the condition holds, print the document+when :: Bool -> Doc a -> Doc a+when cond d = if cond then d else mempty++-- | Apply a printing function to an optional value. If the value is 'Nothing', 'perhaps' returns+-- the empty 'Doc'.+perhaps :: (a -> Doc b) -> Maybe a -> Doc b+perhaps = maybe mempty++-- | Indent the given 'Doc', but only if multi-line+indent :: Int -> Doc a -> Doc a+indent m doc = PP.flatAlt (PP.indent m doc) (flatten doc)++-- | Undo what group does. This function is pretty dangerous...+ungroup :: Doc a -> Doc a+ungroup (Union _ x) = x+ungroup y = y++-- | Remove all indent+noIndent :: Doc a -> Doc a+noIndent d = PP.nesting (\i -> PP.nest (negate i) d)++-- | Translate '\n' in a string using the provided 'Doc' instead of 'line'+string :: Doc a -> String -> Doc a+string new = foldMap (\c -> case c of { '\n' -> new; _ -> Char c })++-- | This is the most general function for printing blocks. It operates with any delimiter, any+-- seperator, an optional leading attribute doc (which isn't followed by a seperator), and wraps a+-- list of entries. It has been tweaked to look Just Right (TM) for the usual cases.+--+-- Note that this will try to fit things on one line when possible, so if you want a block that is+-- sure /not/ to be condensed on one line (e.g. for a function), you have to construct it manually.+block :: Delim -- ^ outer delimiters+ -> Bool -- ^ prefer to be on one line (as opposed to multiline)? + -> Doc a -- ^ seperator+ -> Doc a -- ^ attributes doc, after which no seperator will (use 'mempty' to ignore)+ -> [Doc a] -- ^ entries+ -> Doc a+block delim p s as xs = group' (lDel # PP.vsep (as' ++ ys) # rDel)+ where+ group' = if p || null (as' ++ ys) then PP.group else id++ -- left and right delimiter lists+ (lDel,rDel) = case delim of+ Paren -> ("(", ")")+ Bracket -> ("[", "]")+ Brace -> ("{", "}")+ NoDelim -> (mempty, mempty)++ -- method of contenating delimiters with the rest of the body+ (#) = case delim of { Paren -> (<##>); _ -> (<#>) }++ -- attributes+ as' = case as of+ Empty -> []+ _ -> [ PP.flatAlt (PP.indent n as) (flatten as) ]++ -- list of entries+ ys = go xs where go [] = []+ go [z] = [ PP.flatAlt (PP.indent n z <> s) (flatten z) ]+ go (z:zs) = PP.flatAlt (PP.indent n z <> s) (flatten z <> s) : go zs+ +
+ src/Language/Rust/Quote.hs view
@@ -0,0 +1,232 @@+{-|+Module : Language.Rust.Quote+Description : Quasiquotes for Rust AST+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++Quasiquoters for converting Rust code into the equivalent Haskell patterns and expressions.+These are just convenience wrappers over 'dataToExpQ' and 'dataToPatQ'. These quasiquoters+only work as expressions and patterns, not as declarations or types. The pattern quasiquoters+recursively ignore any 'Span' or 'Position' fields (replacing them with wildcard patterns).++Using quasiquotes instead of manually writing out the AST means that even if the AST evolves+(perhaps by adding extra fields to certain nodes), your code is likely to continue to work.++The examples below assume the following GHCi flag and import:++>>> :set -XQuasiQuotes+>>> import Control.Monad ( void )+-}+{-# LANGUAGE RankNTypes, QuasiQuotes, TemplateHaskell #-}++module Language.Rust.Quote (+ lit, attr, ty, pat, stmt, expr, item, sourceFile, implItem, traitItem, tokenTree, block,+ stmts, items, implItems+) where++{-+In the future, we may try to do something similar to Rust macros to extract or inject ASTs out or+into the quasiquotes.++Eventually, one should be able to just import this module for code generation. The following+interaction is what should eventually work.++>>> import qualified Language.Rust.Quote as Q+>>> :set -XQuasiQuotes +t+>>> let one = [Q.expr| 1i32 |]+one :: Expr Span+>>> [Q.expr| |x: i32| -> $retTy:ty $body:block |] = [Q.expr| |x: i32| -> i32 { ($one) + x } |]+retTy :: Ty Span+body :: Block Span+>>> import Language.Rust.Pretty+>>> pretty retTy+i32+>>> pretty body+{ (1i32) + x }++For now, however, you cannot use @$x@ or @$x:ty@ meta variables.+-}++import Language.Rust.Parser.ParseMonad+import Language.Rust.Parser.Internal+import Language.Rust.Data.InputStream ( inputStreamFromString )+import Language.Rust.Data.Position ( Position(..), Span )+import Language.Rust.Data.Ident ( Ident(..), IdentName(..), mkIdent )+import Language.Rust.Syntax.AST ( Expr(EmbeddedExpr), TokenTree(..) )+import Language.Rust.Syntax.Token ( Token(..) )++import Language.Haskell.TH.Syntax ( liftData ) -- liftData :: Data a => a -> Q Exp+import Language.Haskell.TH+import Language.Haskell.TH.Quote ( QuasiQuoter(..), dataToExpQ, dataToPatQ )+import qualified Language.Haskell.Meta as LHM++import Control.Applicative ( (<|>) )+import Control.Monad ( (>=>) )+import Data.Functor ( ($>) )+import Data.Typeable ( cast, Typeable )+import Data.Data ( Data )++-- | Given a parser, convert it into a quasiquoter. The quasiquoter produced does not support+-- declarations and types. For patterns, it replaces any 'Span' and 'Position' field with a+-- wild pattern.+quoter :: Data a => (forall b. Typeable b => b -> Maybe (Q Exp)) -> P a -> QuasiQuoter+--quoter :: P ExpQ -> QuasiQuoter+quoter exprTransformer p = QuasiQuoter+ { quoteExp = parse >=> dataToExpQ exprTransformer+ , quotePat = parse >=> dataToPatQ wildSpanPos+ , quoteDec = error "this quasiquoter does not support declarations"+ , quoteType = error "this quasiquoter does not support types"+ }+ where+ -- | Given a parser and an input string, turn it into the corresponding Haskell expression/pattern.+ parse inp = do+ Loc{ loc_start = (r,c) } <- location+ + -- Run the parser+ case execParser p (inputStreamFromString inp) (Position 0 r c) of+ Left (ParseFail _ msg) -> fail msg+ Right x -> pure x++ -- | Replace 'Span' and 'Position' with wild patterns+ wildSpanPos :: Typeable b => b -> Maybe (Q Pat)+ wildSpanPos x = ((cast x :: Maybe Span) $> wildP) <|> ((cast x :: Maybe Position) $> wildP)++castExpr :: Typeable b => b -> Maybe (String, Q Exp -> Q Exp)+castExpr b = do+ (EmbeddedExpr _ code _) <- cast b :: Maybe (Expr Span)+ pure (code, id)++castIdent :: Typeable b => b -> Maybe (String, Q Exp -> Q Exp)+castIdent b = do+ (Ident (HaskellName code) _ _) <- cast b :: Maybe Ident+ pure (code, (\e -> [| mkIdent $(e) |]))++castTokenIDENT :: Typeable b => b -> Maybe (String, Q Exp -> Q Exp)+castTokenIDENT b = do+ (Token spn (EmbeddedIdent code)) <- cast b :: Maybe TokenTree+ pure (code, \e -> [| Token $(liftData spn) (IdentTok $ mkIdent $(e)) |])++castTokenEXPR :: Typeable b => b -> Maybe (String, Q Exp -> Q Exp)+castTokenEXPR b = do+ (Token spn (EmbeddedCode code)) <- cast b :: Maybe TokenTree+ pure (code, \e -> [| Token $(liftData spn) $(e) |])++--(EmbeddedExpr _ code _) <- (cast b :: Maybe (Expr Span))++embeddedCode :: Typeable b => b -> Maybe (Q Exp)+embeddedCode b = do+ (code, tsfm) <- castExpr b <|> castIdent b <|> castTokenIDENT b <|> castTokenEXPR b+ pure $ case LHM.parseExp code of+ Left err -> error $ "Could not parse embedded Haskell code: " ++ err+ Right expTH -> tsfm $ return expTH++-- | Quasiquoter for literals (see 'Language.Rust.Syntax.Lit').+--+-- >>> void [lit| 1.4e29f64 |]+-- Float 1.4e29 F64 ()+--+lit :: QuasiQuoter+lit = quoter (const Nothing) parseLit++-- | Quasiquoter for attributes (see 'Language.Rust.Syntax.Attribute')+--+-- >>> void [attr| #[no_mangle] |]+-- Attribute Outer (Path False [PathSegment "no_mangle" Nothing ()] ()) (Stream []) ()+--+attr :: QuasiQuoter+attr = quoter embeddedCode parseAttr++-- | Quasiquoter for types (see 'Language.Rust.Syntax.Ty')+--+-- >>> void [ty| &(_,_) |]+-- Rptr Nothing Immutable (TupTy [Infer (),Infer ()] ()) ()+--+ty :: QuasiQuoter+ty = quoter embeddedCode parseTy++-- | Quasiquoter for patterns (see 'Language.Rust.Syntax.Pat')+--+-- >>> void [pat| x @ 1...5 |]+-- IdentP (ByValue Immutable) "x" (Just (RangeP (Lit [] (Int Dec 1 Unsuffixed ()) ())+-- (Lit [] (Int Dec 5 Unsuffixed ()) ()) ())) ()+--+pat :: QuasiQuoter+pat = quoter embeddedCode parsePat++-- | Quasiquoter for statements (see 'Language.Rust.Syntax.Stmt')+--+-- >>> void [stmt| let x = 4i32; |]+-- Local (IdentP (ByValue Immutable) "x" Nothing ()) Nothing (Just (Lit [] (Int Dec 4 I32 ()) ())) [] ()+--+stmt :: QuasiQuoter+stmt = quoter embeddedCode parseStmt+stmts :: QuasiQuoter+stmts = quoter embeddedCode parseStmts++-- | Quasiquoter for expressions (see 'Language.Rust.Syntax.Expr')+--+-- >>> void [expr| (x,) |]+-- TupExpr [] [PathExpr [] Nothing (Path False [PathSegment "x" Nothing ()] ()) ()] ()+--+expr :: QuasiQuoter+expr = quoter embeddedCode parseExpr++-- | Quasiquoter for items (see 'Language.Rust.Syntax.Item')+--+-- >>> void [item| type Unit = (); |]+-- TyAlias [] InheritedV "Unit" (TupTy [] ()) (Generics [] [] (WhereClause [] ()) ()) ()+--+item :: QuasiQuoter+item = quoter embeddedCode parseItem+items :: QuasiQuoter+items = quoter embeddedCode parseItems++-- | Quasiquoter for a whole source file (see 'Language.Rust.Syntax.SourceFile')+--+-- >>> void [sourceFile| fn main() { } |]+-- SourceFile Nothing [] [Fn [] InheritedV "main"+-- (FnDecl [] Nothing False ())+-- Normal NotConst Rust+-- (Generics [] [] (WhereClause [] ()) ())+-- (Block [] Normal ()) ()]+--+sourceFile :: QuasiQuoter+sourceFile = quoter embeddedCode parseSourceFile++-- | Quasiquoter for blocks (see 'Language.Rust.Syntax.Block')+--+-- >>> void [block| unsafe { 1i32 } |]+-- Block [NoSemi (Lit [] (Int Dec 1 I32 ()) ()) ()] Unsafe ()+--+block :: QuasiQuoter+block = quoter embeddedCode parseBlock++-- | Quasiquoter for impl items (see 'Language.Rust.Syntax.ImplItem')+--+-- >>> void [implItem| type Item = (); |]+-- TypeI [] InheritedV Final "Item" (TupTy [] ()) ()+--+implItem :: QuasiQuoter+implItem = quoter embeddedCode parseImplItem+implItems :: QuasiQuoter+implItems = quoter embeddedCode parseImplItems++-- | Quasiquoter for trait items (see 'Language.Rust.Syntax.TraitItem')+--+-- >>> void [traitItem| type Item; |]+-- TypeT [] "Item" [] Nothing ()+--+traitItem :: QuasiQuoter+traitItem = quoter embeddedCode parseTraitItem++-- | Quasiquoter for token trees (see 'Language.Rust.Syntax.TokenTree')+--+-- >>> [tokenTree| fn |]+-- Token (Span (Position 1 2 14) (Position 3 2 16)) fn+--+tokenTree :: QuasiQuoter+tokenTree = quoter embeddedCode parseTt+
+ src/Language/Rust/Syntax.hs view
@@ -0,0 +1,29 @@+{-|+Module : Language.Rust.Syntax+Description : Syntax data defintions+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++This module defines Haskell data types corresponding to the abstract syntax tree(s) of the Rust+language, based on the definitions @rustc@ uses (defined in @libsyntax@) whenever possible.+Unfortunately, since the internals of @rustc@ are not exposed, there are no official+docs. <Here https://manishearth.github.io/rust-internals-docs/syntax/ast/index.html> are the+unofficial docs.+-}++module Language.Rust.Syntax (+ -- * Abstract syntax trees+ module Language.Rust.Syntax.AST,+ -- * Tokens+ module Language.Rust.Syntax.Token,+) where++import Language.Rust.Syntax.AST+import Language.Rust.Syntax.Token ++-- Using import/export shortcut screws up Haddock+{-# ANN module "HLint: ignore Use import/export shortcut" #-}+
+ src/Language/Rust/Syntax/AST.hs view
@@ -0,0 +1,1206 @@+{-|+Module : Language.Rust.Syntax.AST+Description : Non-token AST definitions+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC+-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}++module Language.Rust.Syntax.AST (+ -- ** Top level+ SourceFile(..),++ -- ** General+ Mutability(..),+ Unsafety(..),+ Arg(..),+ FnDecl(..),++ -- ** Paths+ Path(..),+ PathParameters(..),+ PathSegment(..),+ QSelf(..),++ -- ** Attributes+ Attribute(..),+ AttrStyle(..),++ -- ** Literals+ Lit(..),+ byteStr,+ Suffix(..),+ suffix,+ IntRep(..),+ StrStyle(..),++ -- ** Expressions+ Expr(..),+ Abi(..),+ Arm(..),+ UnOp(..),+ BinOp(..),+ Label(..),+ CaptureBy(..),+ Movability(..),+ Field(..),+ RangeLimits(..),++ -- ** Types and lifetimes+ Ty(..),+ Generics(..),+ Lifetime(..),+ LifetimeDef(..),+ TyParam(..),+ TyParamBound(..),+ partitionTyParamBounds,+ WhereClause(..),+ whereClause,+ WherePredicate(..),+ PolyTraitRef(..),+ TraitRef(..),+ TraitBoundModifier(..),++ -- ** Patterns+ Pat(..),+ BindingMode(..),+ FieldPat(..),++ -- ** Statements+ Stmt(..),++ -- ** Items+ Item(..),+ ForeignItem(..),+ ImplItem(..),+ TraitItem(..),+ Defaultness(..),+ ImplPolarity(..),+ StructField(..),+ Variant(..),+ VariantData(..),+ UseTree(..),+ Visibility(..),+ Constness(..),+ MethodSig(..),++ -- ** Blocks+ Block(..),++ -- ** Token trees+ TokenTree(..),+ TokenStream(..),+ unconsTokenStream,+ Nonterminal(..),+ Mac(..),+ MacStmtStyle(..),+) where++import Language.Rust.Data.Ident ( Ident, Name )+import Language.Rust.Data.Position+import {-# SOURCE #-} Language.Rust.Syntax.Token ( Delim, Token )++import GHC.Generics ( Generic, Generic1 )++import Control.DeepSeq ( NFData )+import Data.Data ( Data )+import Data.Typeable ( Typeable )++import Data.Char ( ord )+import Data.List ( partition )+import Language.Rust.Parser.NonEmpty ( NonEmpty(..) )+import Data.Semigroup as Sem ( Semigroup(..) )+import Data.Word ( Word8 )++-- | ABIs support by Rust's foreign function interface (@syntax::abi::Abi@). Note that of these,+-- only 'Rust', 'C', 'System', 'RustIntrinsic', 'RustCall', and 'PlatformIntrinsic' and 'Unadjusted'+-- are cross-platform - all the rest are platform-specific.+--+-- Example: @\"C\"@ as in @extern \"C\" fn foo(x: i32);@+data Abi+ -- Platform-specific ABIs+ = Cdecl+ | Stdcall+ | Fastcall+ | Vectorcall+ | Aapcs+ | Win64+ | SysV64+ | PtxKernel+ | Msp430Interrupt+ | X86Interrupt+ -- Cross-platform ABIs+ | Rust+ | C+ | System+ | RustIntrinsic+ | RustCall+ | PlatformIntrinsic+ | Unadjusted+ deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic, NFData)++-- | An argument in a function header (@syntax::ast::Arg@, except with @SelfKind@ and @ExplicitSelf@+-- inlined).+--+-- Example: @x: usize@, @self@, @mut self@, @&self@, @&'lt mut self@, @mut self: Foo@ as in+--+-- @+-- trait Foo {+-- // Regular argument+-- fn new(x: usize) -> Foo;+-- +-- // Self argument, by value+-- fn foo(self) -> i32;+-- fn bar(mut self);+--+-- // Self argument, by reference+-- fn baz(&self) -> Bar\<'lt\>;+-- fn qux(&'lt mut self) -> Bar\<'lt\>;+--+-- // Explicit self argument+-- fn quux(mut self: Foo);+-- }+-- @+data Arg a+ = Arg (Maybe (Pat a)) (Ty a) a -- ^ Regular argument + | SelfValue Mutability a -- ^ Self argument, by value + | SelfRegion (Maybe (Lifetime a)) Mutability a -- ^ Self argument, by reference+ | SelfExplicit (Ty a) Mutability a -- ^ Explicit self argument+ deriving (Eq, Ord, Show, Functor, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Arg a) where+ spanOf (Arg _ _ s) = spanOf s+ spanOf (SelfValue _ s) = spanOf s+ spanOf (SelfRegion _ _ s) = spanOf s+ spanOf (SelfExplicit _ _ s) = spanOf s++-- | An arm of a 'Match' expression (@syntax::ast::Arm@). An arm has at least one patten, possibly a+-- guard expression, and a body expression.+--+-- Example: @n if n % 4 == 3 => { println!("{} % 4 = 3", n) }@ as in+--+-- @+-- match n {+-- n if n % 4 == 3 => { println!("{} % 4 = 3", n) }+-- n if n % 4 == 1 => { println!("{} % 4 = 1", n) }+-- _ => println!("{} % 2 = 0", n)+-- }+-- @+data Arm a = Arm [Attribute a] (NonEmpty (Pat a)) (Maybe (Expr a)) (Expr a) a+ deriving (Eq, Ord, Show, Functor, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Arm a) where spanOf (Arm _ _ _ _ s) = spanOf s++-- | 'Attribute's are annotations for other AST nodes (@syntax::ast::Attribute@). Note that+-- doc-comments are promoted to attributes.+--+-- Example: @#[derive(Copy,Clone)]@ as in+--+-- @+-- #[derive(Clone, Copy)]+-- struct Complex { re: f32, im: f32 }+-- @+data Attribute a+ -- | Regular attributes of the form @#[...]@+ = Attribute AttrStyle (Path a) TokenStream a+ -- | Doc comment attributes. The 'Bool' argument identifies if the comment is inline or not, and+ -- the 'Name' contains the actual doc comment content.+ | SugaredDoc AttrStyle Bool Name a+ deriving (Eq, Ord, Show, Functor, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Attribute a) where+ spanOf (Attribute _ _ _ s) = spanOf s+ spanOf (SugaredDoc _ _ _ s) = spanOf s++-- | Distinguishes between attributes that are associated with the node that follows them and+-- attributes that are associated with the node that contains them (@syntax::ast::AttrStyle@).+-- These two cases need to be distinguished only for pretty printing - they are otherwise+-- fundamentally equivalent.+--+-- Example: @#[repr(C)]@ is an outer attribute while @#![feature(slice_patterns)]@ is an inner one+data AttrStyle = Outer | Inner deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Binary operators, used in the 'Binary' and 'AssignOp' constructors of 'Expr'+-- (@syntax::ast::BinOp@).+--+-- Example: @+@ as in @1 + 1@ or @1 += 1@+data BinOp+ = AddOp -- ^ @+@ operator (addition)+ | SubOp -- ^ @-@ operator (subtraction)+ | MulOp -- ^ @*@ operator (multiplication)+ | DivOp -- ^ @/@ operator (division)+ | RemOp -- ^ @%@ operator (modulus)+ | AndOp -- ^ @&&@ operator (logical and)+ | OrOp -- ^ @||@ operator (logical or)+ | BitXorOp -- ^ @^@ operator (bitwise xor)+ | BitAndOp -- ^ @&@ operator (bitwise and)+ | BitOrOp -- ^ @|@ operator (bitwise or)+ | ShlOp -- ^ @<<@ operator (shift left)+ | ShrOp -- ^ @>>@ operator (shift right)+ | EqOp -- ^ @==@ operator (equality)+ | LtOp -- ^ @< @operator (less than)+ | LeOp -- ^ @<=@ operator (less than or equal to)+ | NeOp -- ^ @!=@ operator (not equal to)+ | GeOp -- ^ @>=@ operator (greater than or equal to)+ | GtOp -- ^ @>@ operator (greater than)+ deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Describes how a value bound to an identifier in a pattern is going to be borrowed+-- (@syntax::ast::BindingMode@). +--+-- Example: @&mut@ in @|&mut x: i32| -> { x += 1 }@+data BindingMode+ = ByRef Mutability+ | ByValue Mutability+ deriving (Eq, Ord, Show, Typeable, Data, Generic, NFData)++-- | A curly brace delimited sequence of statements (@syntax::ast::Block@). The last statement in+-- the block can always be a 'NoSemi' expression.+--+-- Example: @{ let x = 1; return x + y }@ as in @fn foo() { let x = 1; return x + y }@+data Block a = Block [Stmt a] Unsafety a+ deriving (Eq, Ord, Show, Functor, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Block a) where spanOf (Block _ _ s) = spanOf s+ +-- | Describes how a 'Closure' should close over its free variables (@syntax::ast::CaptureBy@).+data CaptureBy+ = Value -- ^ make copies of free variables closed over (@move@ closures)+ | Ref -- ^ borrow free variables closed over+ deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Const annotation to specify if a function or method is allowed to be called in constants+-- context with constant arguments (@syntax::ast::Constness@). [Relevant+-- RFC](https://github.com/rust-lang/rfcs/blob/master/text/0911-const-fn.md) +--+-- Example: @const@ in @const fn inc(x: i32) -> i32 { x + 1 }@+data Constness = Const | NotConst deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | An 'ImplItem' can be marked @default@ (@syntax::ast::Defaultness@). +data Defaultness = Default | Final deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Expression (@syntax::ast::Expr@). Note that Rust pushes into expressions an unusual number+-- of constructs including @if@, @while@, @match@, etc.+data Expr a+ -- | box expression (example: @box x@)+ = Box [Attribute a] (Expr a) a+ -- | in-place expression - first 'Expr' is the place, second one is the value (example: @x <- y@)+ | InPlace [Attribute a] (Expr a) (Expr a) a+ -- | array literal (example: @[a, b, c, d]@)+ | Vec [Attribute a] [Expr a] a+ -- | function call where the first 'Expr' is the function itself, and the @['Expr']@ is the list of+ -- arguments (example: @foo(1,2,x)@)+ | Call [Attribute a] (Expr a) [Expr a] a+ -- | method call where the first 'Expr' is the receiver, 'Ident' is the method name, @Maybe ['Ty']@+ -- the list of type arguments and '[Expr]' the arguments to the method.+ -- (example: @x.foo::\<Bar, Baz\>(a, b, c, d)@+ | MethodCall [Attribute a] (Expr a) Ident (Maybe [Ty a]) [Expr a] a+ -- | tuple (example: @(a, b, c ,d)@)+ | TupExpr [Attribute a] [Expr a] a+ -- | binary operation (example: @a + b@, @a * b@)+ | Binary [Attribute a] BinOp (Expr a) (Expr a) a+ -- | unary operation (example: @!x@, @*x@)+ | Unary [Attribute a] UnOp (Expr a) a+ -- | literal (example: @1@, @"foo"@)+ | Lit [Attribute a] (Lit a) a+ -- | cast (example: @foo as f64@)+ | Cast [Attribute a] (Expr a) (Ty a) a+ -- | type annotation (example: @x: i32@) + | TypeAscription [Attribute a] (Expr a) (Ty a) a+ -- | if expression, with an optional @else@ block. In the case the @else@ block is missing, the+ -- type of the @if@ is inferred to be @()@. (example: @if 1 == 2 { (1,1) } else { (2,2) }@+ | If [Attribute a] (Expr a) (Block a) (Maybe (Expr a)) a+ -- | if-let expression with an optional else block (example: @if let Some(x) = None { () }@)+ | IfLet [Attribute a] (NonEmpty (Pat a)) (Expr a) (Block a) (Maybe (Expr a)) a+ -- | while loop, with an optional label (example: @'lbl: while 1 == 1 { break 'lbl }@)+ | While [Attribute a] (Expr a) (Block a) (Maybe (Label a)) a+ -- | while-let loop, with an optional label (example: @while let Some(x) = None { x }@)+ | WhileLet [Attribute a] (NonEmpty (Pat a)) (Expr a) (Block a) (Maybe (Label a)) a+ -- | for loop, with an optional label (example: @for i in 1..10 { println!("{}",i) }@)+ | ForLoop [Attribute a] (Pat a) (Expr a) (Block a) (Maybe (Label a)) a+ -- | conditionless loop (can be exited with 'Break', 'Continue', or 'Ret')+ | Loop [Attribute a] (Block a) (Maybe (Label a)) a+ -- | match block+ | Match [Attribute a] (Expr a) [Arm a] a+ -- | closure (example: @move |a, b, c| { a + b + c }@)+ | Closure [Attribute a] Movability CaptureBy (FnDecl a) (Expr a) a+ -- | (possibly unsafe) block (example: @unsafe { 1 }@)+ | BlockExpr [Attribute a] (Block a) a+ -- | a catch block (example: @do catch { 1 }@)+ | Catch [Attribute a] (Block a) a+ -- | assignment (example: @a = foo()@)+ | Assign [Attribute a] (Expr a) (Expr a) a+ -- | assignment with an operator (example: @a += 1@)+ | AssignOp [Attribute a] BinOp (Expr a) (Expr a) a+ -- | access of a named struct field (example: @obj.foo@)+ | FieldAccess [Attribute a] (Expr a) Ident a+ -- | access of an unnamed field of a struct or tuple-struct (example: @foo.0@)+ | TupField [Attribute a] (Expr a) Int a+ -- | indexing operation (example: @foo[2]@)+ | Index [Attribute a] (Expr a) (Expr a) a+ -- | range (examples: @1..2@, @1..@, @..2@, @1...2@, @1...@, @...2@)+ | Range [Attribute a] (Maybe (Expr a)) (Maybe (Expr a)) RangeLimits a+ -- | variable reference + | PathExpr [Attribute a] (Maybe (QSelf a)) (Path a) a+ -- | referencing operation (example: @&a or &mut a@)+ | AddrOf [Attribute a] Mutability (Expr a) a+ -- | @break@ with an optional label and expression denoting what to break out of and what to+ -- return (example: @break 'lbl 1@) + | Break [Attribute a] (Maybe (Label a)) (Maybe (Expr a)) a+ -- | @continue@ with an optional label (example: @continue@)+ | Continue [Attribute a] (Maybe (Label a)) a+ -- | @return@ with an optional value to be returned (example: @return 1@)+ | Ret [Attribute a] (Maybe (Expr a)) a+ -- | macro invocation before expansion+ | MacExpr [Attribute a] (Mac a) a+ -- | struct literal expression (examples: @Foo { x: 1, y: 2 }@ or @Foo { x: 1, ..base }@)+ | Struct [Attribute a] (Path a) [Field a] (Maybe (Expr a)) a+ -- | array literal constructed from one repeated element (example: @[1; 5]@)+ | Repeat [Attribute a] (Expr a) (Expr a) a+ -- | no-op: used solely so we can pretty print faithfully+ | ParenExpr [Attribute a] (Expr a) a+ -- | sugar for error handling with @Result@ (example: @parsed_result?@)+ | Try [Attribute a] (Expr a) a+ -- | @yield@ with an optional value to yield (example: @yield 1@)+ | Yield [Attribute a] (Maybe (Expr a)) a+ -- | embedded Haskell expressions for use by quasiquoters+ | EmbeddedExpr [Attribute a] String a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Expr a) where+ spanOf (Box _ _ s) = spanOf s+ spanOf (InPlace _ _ _ s) = spanOf s+ spanOf (Vec _ _ s) = spanOf s+ spanOf (Call _ _ _ s) = spanOf s+ spanOf (MethodCall _ _ _ _ _ s) = spanOf s+ spanOf (TupExpr _ _ s) = spanOf s+ spanOf (Binary _ _ _ _ s) = spanOf s+ spanOf (Unary _ _ _ s) = spanOf s+ spanOf (Lit _ _ s) = spanOf s+ spanOf (Cast _ _ _ s) = spanOf s+ spanOf (TypeAscription _ _ _ s) = spanOf s+ spanOf (If _ _ _ _ s) = spanOf s+ spanOf (IfLet _ _ _ _ _ s) = spanOf s+ spanOf (While _ _ _ _ s) = spanOf s+ spanOf (WhileLet _ _ _ _ _ s) = spanOf s+ spanOf (ForLoop _ _ _ _ _ s) = spanOf s+ spanOf (Loop _ _ _ s) = spanOf s+ spanOf (Match _ _ _ s) = spanOf s+ spanOf (Closure _ _ _ _ _ s) = spanOf s+ spanOf (BlockExpr _ _ s) = spanOf s+ spanOf (Catch _ _ s) = spanOf s+ spanOf (Assign _ _ _ s) = spanOf s+ spanOf (AssignOp _ _ _ _ s) = spanOf s+ spanOf (FieldAccess _ _ _ s) = spanOf s+ spanOf (TupField _ _ _ s) = spanOf s+ spanOf (Index _ _ _ s) = spanOf s+ spanOf (Range _ _ _ _ s) = spanOf s+ spanOf (PathExpr _ _ _ s) = spanOf s+ spanOf (AddrOf _ _ _ s) = spanOf s+ spanOf (Break _ _ _ s) = spanOf s+ spanOf (Continue _ _ s) = spanOf s+ spanOf (Ret _ _ s) = spanOf s+ spanOf (MacExpr _ _ s) = spanOf s+ spanOf (Struct _ _ _ _ s) = spanOf s+ spanOf (Repeat _ _ _ s) = spanOf s+ spanOf (ParenExpr _ _ s) = spanOf s+ spanOf (Try _ _ s) = spanOf s+ spanOf (Yield _ _ s) = spanOf s+ spanOf (EmbeddedExpr _ _ s) = spanOf s++-- | Field in a struct literal expression (@syntax::ast::Field@).+--+-- Example: @x: 1@ in @Point { x: 1, y: 2 }@+data Field a = Field Ident (Maybe (Expr a)) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Field a) where spanOf (Field _ _ s) = spanOf s++-- | Field in a struct literal pattern (@syntax::ast::FieldPat@). The field name 'Ident' is optional+-- but, when it is 'Nothing', the pattern the field is destructured to must be 'IdentP'.+--+-- Example: @x@ in @Point { x, y }@+data FieldPat a = FieldPat (Maybe Ident) (Pat a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (FieldPat a) where spanOf (FieldPat _ _ s) = spanOf s++-- | Header (not the body) of a function declaration (@syntax::ast::FnDecl@). The 'Bool' argument+-- indicates whether the header is variadic (so whether the argument list ends in @...@).+--+-- Example: @(bar: i32) -> i32@ as in+--+-- @+-- fn foo(bar: i32) -> i32 {+-- bar + 2+-- }+-- @+data FnDecl a = FnDecl [Arg a] (Maybe (Ty a)) Bool a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (FnDecl a) where spanOf (FnDecl _ _ _ s) = spanOf s++-- | An item within an extern block (@syntax::ast::ForeignItem@ with @syntax::ast::ForeignItemKind@+-- inlined).+--+-- Example: @static ext: u8@ in @extern \"C\" { static ext: u8 }@+data ForeignItem a+ -- | Foreign function+ --+ -- Example: @fn foo(x: i32);@ in @extern \"C\" { fn foo(x: i32); }@+ = ForeignFn [Attribute a] (Visibility a) Ident (FnDecl a) (Generics a) a+ -- | Foreign static variable, optionally mutable+ --+ -- Example: @static mut bar: i32;@ in @extern \"C\" { static mut bar: i32; }@+ | ForeignStatic [Attribute a] (Visibility a) Ident (Ty a) Mutability a+ -- | Foreign type+ --+ -- Example: @type Boo;@+ | ForeignTy [Attribute a] (Visibility a) Ident a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (ForeignItem a) where+ spanOf (ForeignFn _ _ _ _ _ s) = spanOf s+ spanOf (ForeignStatic _ _ _ _ _ s) = spanOf s+ spanOf (ForeignTy _ _ _ s) = spanOf s++-- | Represents lifetimes and type parameters attached to a declaration of a functions, enums,+-- traits, etc. (@syntax::ast::Generics@). Note that lifetime definitions are always required to be+-- before the type parameters.+--+-- This one AST node is also a bit weird: it is the only node whose source representation is not+-- compact - the lifetimes and type parameters occur by themselves between @\<@ and @\>@ then a+-- bit further the where clause occurs after a @where@.+--+-- Example: @\<\'a, \'b: \'c, T: \'a\>@ and @where Option\<T\>: Copy@ as in+--+-- @+-- fn nonsense\<\'a, \'b: \'c, T: \'a\>(x: i32) -\> i32+-- where Option\<T\>: Copy { +-- 1+-- }@.+data Generics a = Generics [LifetimeDef a] [TyParam a] (WhereClause a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++-- | Extract the where clause from a 'Generics'.+whereClause :: Generics a -> WhereClause a+whereClause (Generics _ _ wc _) = wc++instance Located a => Located (Generics a) where spanOf (Generics _ _ _ s) = spanOf s++instance Sem.Semigroup a => Sem.Semigroup (Generics a) where+ Generics lt1 tp1 wc1 x1 <> Generics lt2 tp2 wc2 x2 = Generics lts tps wcs xs+ where lts = lt1 ++ lt2+ tps = tp1 ++ tp2+ wcs = wc1 <> wc2+ xs = x1 <> x2++instance (Sem.Semigroup a, Monoid a) => Monoid (Generics a) where+ mappend = (<>)+ mempty = Generics [] [] mempty mempty++-- | An item within an impl (@syntax::ast::ImplItem@ with @syntax::ast::ImplItemKind@ inlined).+--+-- Examples:+--+-- @+-- impl MyTrait {+-- // Associated constant+-- const ID: i32 = 1;+--+-- // Method+-- fn area(&self) -> f64 { 1f64 }+--+-- // Associated type+-- type N = i32;+--+-- // Call to a macro+-- foo!{}+-- }+-- @+data ImplItem a+ -- | Associated constant+ = ConstI [Attribute a] (Visibility a) Defaultness Ident (Ty a) (Expr a) a+ -- | Method+ | MethodI [Attribute a] (Visibility a) Defaultness Ident (Generics a) (MethodSig a) (Block a) a+ -- | Associated type+ | TypeI [Attribute a] (Visibility a) Defaultness Ident (Ty a) a+ -- | Macro call+ | MacroI [Attribute a] Defaultness (Mac a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (ImplItem a) where+ spanOf (ConstI _ _ _ _ _ _ s) = spanOf s+ spanOf (MethodI _ _ _ _ _ _ _ s) = spanOf s+ spanOf (TypeI _ _ _ _ _ s) = spanOf s+ spanOf (MacroI _ _ _ s) = spanOf s++-- | For traits with a default impl, one can "opt out" of that impl with a negative impl, by adding+-- @!@ mark before the trait name. [RFC on builtin+-- traits](https://github.com/rust-lang/rfcs/blob/master/text/0019-opt-in-builtin-traits.md)+--+-- Example: @!@ as in @impl !Trait for Foo { }@+data ImplPolarity = Positive | Negative deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | A top-level item, possibly in a 'Mod' or a 'ItemStmt' (@syntax::ast::Item@ with+-- @syntax::ast::ItemKind@ inlined).+--+-- Example: @fn main() { return; }@+data Item a+ -- | extern crate item, with optional original crate name.+ -- Examples: @extern crate foo@ or @extern crate foo_bar as foo@+ = ExternCrate [Attribute a] (Visibility a) Ident (Maybe Ident) a+ -- | use declaration (@use@ or @pub use@) item.+ -- Examples: @use foo;@, @use foo::bar;@, or @use foo::bar as FooBar;@+ | Use [Attribute a] (Visibility a) (UseTree a) a+ -- | static item (@static@ or @pub static@).+ -- Examples: @static FOO: i32 = 42;@ or @static FOO: &'static str = "bar";@+ | Static [Attribute a] (Visibility a) Ident (Ty a) Mutability (Expr a) a+ -- | constant item (@const@ or @pub const@).+ -- Example: @const FOO: i32 = 42;@+ | ConstItem [Attribute a] (Visibility a) Ident (Ty a) (Expr a) a+ -- | function declaration (@fn@ or @pub fn@).+ -- Example: @fn foo(bar: usize) -\> usize { .. }@+ | Fn [Attribute a] (Visibility a) Ident (FnDecl a) Unsafety Constness Abi (Generics a) (Block a) a+ -- | module declaration (@mod@ or @pub mod@) (@syntax::ast::Mod@).+ -- Example: @mod foo;@ or @mod foo { .. }@+ | Mod [Attribute a] (Visibility a) Ident (Maybe [Item a]) a+ -- | external module (@extern@ or @pub extern@) (@syntax::ast::ForeignMod@).+ -- Example: @extern { .. }@ or @extern \"C\" { .. }@+ | ForeignMod [Attribute a] (Visibility a) Abi [ForeignItem a] a+ -- | type alias (@type@ or @pub type@).+ -- Example: @type Foo = Bar\<u8\>;@+ | TyAlias [Attribute a] (Visibility a) Ident (Ty a) (Generics a) a+ -- | enum definition (@enum@ or @pub enum@) (@syntax::ast::EnumDef@).+ -- Example: @enum Foo\<A, B\> { C(A), D(B) }@+ | Enum [Attribute a] (Visibility a) Ident [Variant a] (Generics a) a+ -- | struct definition (@struct@ or @pub struct@).+ -- Example: @struct Foo\<A\> { x: A }@+ | StructItem [Attribute a] (Visibility a) Ident (VariantData a) (Generics a) a+ -- | union definition (@union@ or @pub union@).+ -- Example: @union Foo\<A, B\> { x: A, y: B }@+ | Union [Attribute a] (Visibility a) Ident (VariantData a) (Generics a) a+ -- | trait declaration (@trait@ or @pub trait@).+ -- Example: @trait Foo { .. }@ or @trait Foo\<T\> { .. }@+ | Trait [Attribute a] (Visibility a) Ident Bool Unsafety (Generics a) [TyParamBound a] [TraitItem a] a+ -- | trait alias+ -- Example: @trait Foo = Bar + Quux;@+ | TraitAlias [Attribute a] (Visibility a) Ident (Generics a) (NonEmpty (TyParamBound a)) a+ -- | implementation+ -- Example: @impl\<A\> Foo\<A\> { .. }@ or @impl\<A\> Trait for Foo\<A\> { .. }@+ | Impl [Attribute a] (Visibility a) Defaultness Unsafety ImplPolarity (Generics a) (Maybe (TraitRef a)) (Ty a) [ImplItem a] a+ -- | generated from a call to a macro + -- Example: @foo!{ .. }@+ | MacItem [Attribute a] (Maybe Ident) (Mac a) a+ -- | definition of a macro via @macro_rules@+ -- Example: @macro_rules! foo { .. }@+ | MacroDef [Attribute a] Ident TokenStream a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Item a) where+ spanOf (ExternCrate _ _ _ _ s) = spanOf s+ spanOf (Use _ _ _ s) = spanOf s+ spanOf (Static _ _ _ _ _ _ s) = spanOf s+ spanOf (ConstItem _ _ _ _ _ s) = spanOf s+ spanOf (Fn _ _ _ _ _ _ _ _ _ s) = spanOf s+ spanOf (Mod _ _ _ _ s) = spanOf s+ spanOf (ForeignMod _ _ _ _ s) = spanOf s+ spanOf (TyAlias _ _ _ _ _ s) = spanOf s+ spanOf (Enum _ _ _ _ _ s) = spanOf s+ spanOf (StructItem _ _ _ _ _ s) = spanOf s+ spanOf (Union _ _ _ _ _ s) = spanOf s+ spanOf (Trait _ _ _ _ _ _ _ _ s) = spanOf s+ spanOf (TraitAlias _ _ _ _ _ s) = spanOf s+ spanOf (Impl _ _ _ _ _ _ _ _ _ s) = spanOf s+ spanOf (MacItem _ _ _ s) = spanOf s+ spanOf (MacroDef _ _ _ s) = spanOf s++-- | Used to annotate loops, breaks, continues, etc.+data Label a = Label Name a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Label a) where spanOf (Label _ s) = spanOf s++-- | A lifetime is a name for a scope in a program (@syntax::ast::Lifetime@). One of the novel+-- features of Rust is that code can be parametrized over lifetimes. Syntactically, they are like+-- regular identifiers, but start with a tick @\'@ mark. The 'Name' argument is /not/ supposed to+-- include that tick.+--+-- Examples: @\'a@ or @\'static@+data Lifetime a = Lifetime Name a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Lifetime a) where spanOf (Lifetime _ s) = spanOf s++-- | A lifetime definition, introducing a lifetime and the other lifetimes that bound it+-- (@syntax::ast::LifetimeDef@).+--+-- Example: @\'a: \'b + \'c + \'d@+data LifetimeDef a = LifetimeDef [Attribute a] (Lifetime a) [Lifetime a] a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (LifetimeDef a) where spanOf (LifetimeDef _ _ _ s) = spanOf s++-- | This is the fundamental unit of parsing - it represents the contents of one source file. It is+-- composed of an optional shebang line, inner attributes that follow, and then the module items.+--+-- Example:+--+-- @+-- #!\/usr\/bin/env rust+--+-- #![allow(dead_code)]+--+-- fn main() {+-- println!("Hello world")+-- }+-- @+data SourceFile a+ = SourceFile (Maybe Name) [Attribute a] [Item a]+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++-- | The suffix on a literal (unifies @syntax::ast::LitIntType@, @syntax::ast::IntTy@,+-- @syntax::ast::UintTy@, and @syntax::ast::FloatTy@). As of today, only numeric types can have+-- suffixes, but the possibility of adding more (possibly arbitrary) suffixes to literals in general+-- is being kept open intentionally. [RFC about future-proofing literal+-- suffixes](https://github.com/rust-lang/rfcs/blob/master/text/0463-future-proof-literal-suffixes.md)+--+-- Examples: @i32@, @isize@, and @f32@+data Suffix+ = Unsuffixed+ | Is | I8 | I16 | I32 | I64 | I128 + | Us | U8 | U16 | U32 | U64 | U128+ | F32 | F64+ deriving (Eq, Ord, Show, Enum, Bounded, Typeable, Data, Generic, NFData) ++-- | Literals in Rust (@syntax::ast::Lit@). As discussed in 'Suffix', Rust AST is designed to parse+-- suffixes for all literals, even if they are currently only valid on 'Int' and 'Float' literals.+data Lit a+ = Str String StrStyle Suffix a -- ^ string (example: @"foo"@)+ | ByteStr [Word8] StrStyle Suffix a -- ^ byte string (example: @b"foo"@)+ | Char Char Suffix a -- ^ character (example: @\'a\'@)+ | Byte Word8 Suffix a -- ^ byte (example: @b\'f\'@)+ | Int IntRep Integer String Suffix a -- ^ integer (example: @1i32@)+ | Float Double Suffix a -- ^ float (example: @1.12e4@)+ | Bool Bool Suffix a -- ^ boolean (example: @true@)+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Lit a) where+ spanOf (Str _ _ _ s) = spanOf s+ spanOf (ByteStr _ _ _ s) = spanOf s+ spanOf (Char _ _ s) = spanOf s+ spanOf (Byte _ _ s) = spanOf s+ spanOf (Int _ _ _ _ s) = spanOf s+ spanOf (Float _ _ s) = spanOf s+ spanOf (Bool _ _ s) = spanOf s++-- | Smart constructor for 'ByteStr'.+byteStr :: String -> StrStyle -> Suffix -> a -> Lit a+byteStr s = ByteStr (map (fromIntegral . ord) s)++-- | Extract the suffix from a 'Lit'.+suffix :: Lit a -> Suffix+suffix (Str _ _ s _) = s+suffix (ByteStr _ _ s _) = s+suffix (Char _ s _) = s +suffix (Byte _ s _) = s +suffix (Int _ _ _ s _) = s +suffix (Float _ s _) = s+suffix (Bool _ s _) = s ++-- | The base of the number in an @Int@ literal can be binary (e.g. @0b1100@), octal (e.g. @0o14@),+-- decimal (e.g. @12@), or hexadecimal (e.g. @0xc@).+data IntRep+ = Bin+ | Oct+ | Dec+ | Hex+ deriving (Eq, Ord, Show, Enum, Bounded, Typeable, Data, Generic, NFData)++-- | Represents a macro invocation (@syntax::ast::Mac@). The 'Path' indicates which macro is being+-- invoked, and the 'TokenStream' contains the source of the macro invocation.+data Mac a = Mac (Path a) TokenStream a deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Mac a) where spanOf (Mac _ _ s) = spanOf s++-- | Style of the macro statement (@syntax::ast::MacStmtStyle@).+data MacStmtStyle+ = SemicolonMac -- ^ trailing semicolon (example: @foo! { ... };@, @ foo!(...);@, and @foo![...];@)+ | BracesMac -- ^ braces (example: @foo! { ... }@)+ deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Represents a method's signature in a trait declaration, or in an implementation.+data MethodSig a = MethodSig Unsafety Constness Abi (FnDecl a) deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++-- | The movability of a generator / closure literal (@syntax::ast::Movability@).+data Movability = Immovable | Movable deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Encodes whether something can be updated or changed (@syntax::ast::Mutability@).+data Mutability = Mutable | Immutable deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | For interpolation during macro expansion (@syntax::ast::NonTerminal@).+data Nonterminal a+ = NtItem (Item a)+ | NtBlock (Block a)+ | NtStmt (Stmt a)+ | NtPat (Pat a)+ | NtExpr (Expr a)+ | NtTy (Ty a)+ | NtIdent Ident+ | NtPath (Path a)+ | NtTT TokenTree+ | NtArm (Arm a)+ | NtImplItem (ImplItem a)+ | NtTraitItem (TraitItem a)+ | NtGenerics (Generics a)+ | NtWhereClause (WhereClause a)+ | NtArg (Arg a)+ | NtLit (Lit a)+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++-- | Patterns (@syntax::ast::Pat@).+data Pat a+ -- | wildcard pattern: @_@+ = WildP a+ -- | identifier pattern - either a new bound variable or a unit (tuple) struct pattern, or a+ -- const pattern. Disambiguation cannot be done with parser alone, so it happens during name+ -- resolution. (example: @mut x@)+ | IdentP BindingMode Ident (Maybe (Pat a)) a+ -- | struct pattern. The 'Bool' signals the presence of a @..@. (example: @Variant { x, y, .. }@)+ | StructP (Path a) [FieldPat a] Bool a+ -- | tuple struct pattern. If the @..@ pattern is present, the 'Maybe Int' denotes its position.+ -- (example: @Variant(x, y, .., z)@)+ | TupleStructP (Path a) [Pat a] (Maybe Int) a+ -- | path pattern (example @A::B::C@)+ | PathP (Maybe (QSelf a)) (Path a) a+ -- | tuple pattern. If the @..@ pattern is present, the 'Maybe Int' denotes its position.+ -- (example: @(a, b)@)+ | TupleP [Pat a] (Maybe Int) a+ -- | box pattern (example: @box _@)+ | BoxP (Pat a) a+ -- | reference pattern (example: @&mut (a, b)@)+ | RefP (Pat a) Mutability a+ -- | literal (example: @1@)+ | LitP (Expr a) a+ -- | range pattern (example: @1...2@)+ | RangeP (Expr a) (Expr a) a+ -- | slice pattern where, as per [this RFC](https://github.com/P1start/rfcs/blob/array-pattern-changes/text/0000-array-pattern-changes.md),+ -- the pattern is split into the patterns before/after the @..@ and the pattern at the @..@. (example: @[a, b, ..i, y, z]@)+ | SliceP [Pat a] (Maybe (Pat a)) [Pat a] a+ -- | generated from a call to a macro (example: @LinkedList!(1,2,3)@)+ | MacP (Mac a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Pat a) where+ spanOf (WildP s) = spanOf s+ spanOf (IdentP _ _ _ s) = spanOf s+ spanOf (StructP _ _ _ s) = spanOf s+ spanOf (TupleStructP _ _ _ s) = spanOf s+ spanOf (PathP _ _ s) = spanOf s+ spanOf (TupleP _ _ s) = spanOf s+ spanOf (BoxP _ s) = spanOf s+ spanOf (RefP _ _ s) = spanOf s+ spanOf (LitP _ s) = spanOf s+ spanOf (RangeP _ _ s) = spanOf s+ spanOf (SliceP _ _ _ s) = spanOf s + spanOf (MacP _ s) = spanOf s++-- | Everything in Rust is namespaced using nested modules. A 'Path' represents a path into nested+-- modules, possibly instantiating type parameters along the way (@syntax::ast::Path@). Much like+-- file paths, these paths can be relative or absolute (global) with respect to the crate root.+--+-- Paths are used to identify expressions (see 'PathExpr'), types (see 'PathTy'), and modules+-- (indirectly through 'ViewPath' and such).+--+-- The 'Bool' argument identifies whether the path is relative or absolute.+--+-- Example: @std::cmp::PartialEq@+data Path a = Path Bool [PathSegment a] a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Path a) where spanOf (Path _ _ s) = spanOf s++-- | Parameters on a path segment (@syntax::ast::PathParameters@).+data PathParameters a+ -- | Parameters in a chevron comma-delimited list (@syntax::ast::AngleBracketedParameterData@).+ -- Note that lifetimes must come before types, which must come before bindings. Bindings are+ -- equality constraints on associated types (example: @Foo\<A=Bar\>@)+ --+ -- Example: @\<\'a,A,B,C=i32\>@ in a path segment like @foo::\<'a,A,B,C=i32\>@+ = AngleBracketed [Lifetime a] [Ty a] [(Ident, Ty a)] a+ -- | Parameters in a parenthesized comma-delimited list, with an optional output type+ -- (@syntax::ast::ParenthesizedParameterData@).+ --+ -- Example: @(A,B) -\> C@ in a path segment @Foo(A,B) -\> C@+ | Parenthesized [Ty a] (Maybe (Ty a)) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (PathParameters a) where+ spanOf (AngleBracketed _ _ _ s) = spanOf s+ spanOf (Parenthesized _ _ s) = spanOf s++-- | Segment of a path (@syntax::ast::PathSegment@).+data PathSegment a+ = PathSegment Ident (Maybe (PathParameters a)) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (PathSegment a) where spanOf (PathSegment _ _ s) = spanOf s++-- | Trait ref parametrized over lifetimes introduced by a @for@ (@syntax::ast::PolyTraitRef@).+--+-- Example: @for\<\'a,'b\> Foo\<&\'a Bar\>@ +data PolyTraitRef a = PolyTraitRef [LifetimeDef a] (TraitRef a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (PolyTraitRef a) where spanOf (PolyTraitRef _ _ s) = spanOf s ++-- | The explicit @Self@ type in a "qualified path". The actual path, including the trait and the+-- associated item, is stored separately. The first argument is the type given to @Self@ and the+-- second is the index of the associated qualified with this @Self@ type+data QSelf a = QSelf (Ty a) Int+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++-- | Limit types of a 'Range'+data RangeLimits+ = HalfOpen -- ^ Inclusive at the beginning, exclusive at the end+ | Closed -- ^ Inclusive at the beginning and end+ deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | A statement (@syntax::ast::Stmt@). Rust has relatively few types of statements by turning both+-- expressions (sometimes with a required semicolon at the end) and items into statements.+data Stmt a+ -- | A local @let@ binding (@syntax::ast::Local@) (example: @let x: i32 = 1;@)+ = Local (Pat a) (Maybe (Ty a)) (Maybe (Expr a)) [Attribute a] a+ -- | Item definition (example: @fn foo(x: i32) { return x + 1 }@)+ | ItemStmt (Item a) a+ -- | Expression without a trailing semicolon (example: @x + 1@)+ | NoSemi (Expr a) a+ -- | Expression with a trailing semicolon (example: @x + 1;@)+ | Semi (Expr a) a+ -- | A macro call (example: @println!("hello world")@)+ | MacStmt (Mac a) MacStmtStyle [Attribute a] a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Stmt a) where+ spanOf (Local _ _ _ _ s) = spanOf s+ spanOf (ItemStmt _ s) = spanOf s+ spanOf (NoSemi _ s) = spanOf s+ spanOf (Semi _ s) = spanOf s+ spanOf (MacStmt _ _ _ s) = spanOf s++-- | Style of a string literal (@syntax::ast::StrStyle@).+data StrStyle+ = Cooked -- ^ regular strings (example: @\"foo\"@)+ | Raw Int -- ^ raw strings, with the number of @#@ delimiters (example: @r##\"foo\"##@)+ deriving (Eq, Ord, Show, Typeable, Data, Generic, NFData)++-- | Field of a struct (@syntax::ast::StructField@) used in declarations+--+-- Example: @bar: usize@ as in @struct Foo { bar: usize }@+data StructField a = StructField (Maybe Ident) (Visibility a) (Ty a) [Attribute a] a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (StructField a) where spanOf (StructField _ _ _ _ s) = spanOf s++-- | An abstract sequence of tokens, organized into a sequence (e.g. stream) of 'TokenTree', each of+-- which is a single 'Token' or a 'Delimited' subsequence of tokens.+data TokenStream+ = Tree TokenTree -- ^ a single token or a single set of delimited tokens+ | Stream [TokenStream] -- ^ stream of streams of tokens+ deriving (Eq, Ord, Show, Typeable, Data, Generic, NFData)++-- | A 'TokenStream' is at its core just a stream of 'TokenTree'. This function lets you get at that+-- directly. For example, you can use 'Data.List.unfoldr unconsTokenStream' to convert between a+-- 'TokenStream' and '[TokenTree]'.+unconsTokenStream :: TokenStream -> Maybe (TokenTree, TokenStream)+unconsTokenStream (Tree t) = Just (t, Stream [])+unconsTokenStream (Stream []) = Nothing+unconsTokenStream (Stream (ts:tss)) = case unconsTokenStream ts of+ Nothing -> unconsTokenStream (Stream tss)+ Just (t,ts') -> Just (t, Stream (ts':tss))++-- | 'Span' is not stored on 'TokenStream' - it is computed+instance Located TokenStream where+ spanOf (Tree t) = spanOf t+ spanOf (Stream tt) = spanOf tt++-- | When the parser encounters a macro call, it parses what follows as a 'Delimited' token tree.+-- Basically, token trees let you store raw tokens or 'Sequence' forms inside of balanced+-- parens, braces, or brackets. This is a very loose structure, such that all sorts of different+-- AST-fragments can be passed to syntax extensions using a uniform type.+data TokenTree+ -- | A single token+ = Token Span Token+ -- | A delimited sequence of tokens (@syntax::tokenstream::Delimited@)+ -- Example: @{ [-\>+\<] }@ in @brainfuck!{ [-\>+\<] };@+ | Delimited+ { span :: Span+ , delim :: Delim -- ^ type of delimiter+ , tts :: TokenStream -- ^ delimited sequence of tokens+ }+ deriving (Eq, Ord, Show, Typeable, Data, Generic, NFData)++instance Located TokenTree where+ spanOf (Token s _) = s+ spanOf (Delimited s _ _) = s++-- | Modifier on a bound, currently this is only used for @?Sized@, where the modifier is @Maybe@.+-- Negative bounds should also be handled here.+data TraitBoundModifier = None | Maybe deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Item declaration within a trait declaration (@syntax::ast::TraitItem@ with+-- @syntax::ast::TraitItemKind@ inlined), possibly including a default implementation. A trait item+-- is either required (meaning it doesn't have an implementation, just a signature) or provided+-- (meaning it has a default implementation).+--+-- Examples:+--+-- @+-- trait MyTrait {+-- // Associated constant+-- const ID: i32 = 1;+--+-- // Method+-- fn area(&self) -> f64;+--+-- // Associated type+-- type N: fmt::Display;+--+-- // Call to a macro+-- foo!{}+-- }+-- @+data TraitItem a+ -- | Associated constants+ = ConstT [Attribute a] Ident (Ty a) (Maybe (Expr a)) a+ -- | Method with optional body+ | MethodT [Attribute a] Ident (Generics a) (MethodSig a) (Maybe (Block a)) a+ -- | Possibly abstract associated types+ | TypeT [Attribute a] Ident [TyParamBound a] (Maybe (Ty a)) a+ -- | Call to a macro+ | MacroT [Attribute a] (Mac a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (TraitItem a) where+ spanOf (ConstT _ _ _ _ s) = spanOf s+ spanOf (MethodT _ _ _ _ _ s) = spanOf s+ spanOf (TypeT _ _ _ _ s) = spanOf s+ spanOf (MacroT _ _ s) = spanOf s++-- | A 'TraitRef' is a path which identifies a trait (@syntax::ast::TraitRef@).+newtype TraitRef a = TraitRef (Path a) deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (TraitRef a) where spanOf (TraitRef p) = spanOf p++-- | Types (@syntax::ast::Ty@).+data Ty a+ -- | variable length slice (example: @[T]@)+ = Slice (Ty a) a+ -- | fixed length array (example: @[T; n]@)+ | Array (Ty a) (Expr a) a+ -- | raw pointer (example: @*const T@ or @*mut T@)+ | Ptr Mutability (Ty a) a+ -- | reference (example: @&\'a T@ or @&\'a mut T@)+ | Rptr (Maybe (Lifetime a)) Mutability (Ty a) a+ -- | bare function (example: @fn(usize) -> bool@)+ | BareFn Unsafety Abi [LifetimeDef a] (FnDecl a) a+ -- | never type: @!@+ | Never a+ -- | tuple (example: @(i32, i32)@)+ | TupTy [Ty a] a+ -- | path type (examples: @std::math::pi@, @\<Vec\<T\> as SomeTrait\>::SomeType@).+ | PathTy (Maybe (QSelf a)) (Path a) a+ -- | trait object type (example: @Bound1 + Bound2 + Bound3@)+ | TraitObject (NonEmpty (TyParamBound a)) a+ -- | impl trait type (see the+ -- [RFC](https://github.com/rust-lang/rfcs/blob/master/text/1522-conservative-impl-trait.md))+ -- (example: @impl Bound1 + Bound2 + Bound3@).+ | ImplTrait (NonEmpty (TyParamBound a)) a+ -- | no-op; kept solely so that we can pretty print faithfully+ | ParenTy (Ty a) a+ -- | typeof, currently unsupported in @rustc@ (example: @typeof(1)@)+ | Typeof (Expr a) a+ -- | inferred type: @_@+ | Infer a+ -- | generated from a call to a macro (example: @HList![i32,(),u8]@)+ | MacTy (Mac a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Ty a) where+ spanOf (Slice _ s) = spanOf s+ spanOf (Array _ _ s) = spanOf s+ spanOf (Ptr _ _ s) = spanOf s+ spanOf (Rptr _ _ _ s) = spanOf s+ spanOf (BareFn _ _ _ _ s) = spanOf s+ spanOf (Never s) = spanOf s+ spanOf (TupTy _ s) = spanOf s+ spanOf (PathTy _ _ s) = spanOf s+ spanOf (TraitObject _ s) = spanOf s+ spanOf (ImplTrait _ s) = spanOf s+ spanOf (ParenTy _ s) = spanOf s+ spanOf (Typeof _ s) = spanOf s+ spanOf (Infer s) = spanOf s+ spanOf (MacTy _ s) = spanOf s++-- | Type parameter definition used in 'Generics' (@syntax::ast::TyParam@). Note that each+-- parameter can have any number of (lifetime or trait) bounds, as well as possibly a default type.+data TyParam a = TyParam [Attribute a] Ident [TyParamBound a] (Maybe (Ty a)) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (TyParam a) where spanOf (TyParam _ _ _ _ s) = spanOf s++-- | Bounds that can be placed on types (@syntax::ast::TyParamBound@). These can be either traits or+-- lifetimes.+data TyParamBound a+ = TraitTyParamBound (PolyTraitRef a) TraitBoundModifier a -- ^ trait bound+ | RegionTyParamBound (Lifetime a) a -- ^ lifetime bound+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (TyParamBound a) where+ spanOf (TraitTyParamBound _ _ s) = spanOf s+ spanOf (RegionTyParamBound _ s) = spanOf s++-- | Partition a list of 'TyParamBound' into a tuple of the 'TraitTyParamBound' and+-- 'RegionTyParamBound' variants.+partitionTyParamBounds :: [TyParamBound a] -> ([TyParamBound a], [TyParamBound a])+partitionTyParamBounds = partition isTraitBound+ where+ isTraitBound TraitTyParamBound{} = True+ isTraitBound RegionTyParamBound{} = False++-- | Unary operators, used in the 'Unary' constructor of 'Expr' (@syntax::ast::UnOp@).+--+-- Example: @!@ as in @!true@+data UnOp + = Deref -- ^ @*@ operator (dereferencing)+ | Not -- ^ @!@ operator (logical inversion)+ | Neg -- ^ @-@ operator (negation)+ deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | Qualifies whether something is using unsafe Rust or not (@syntax::ast::Unsafety@). Note that we+-- also use this to describe whether a 'Block' is unsafe or not, while Rust has a seperate structure+-- (@syntax::ast::BlockCheckMode@) for that. This is because they also need to keep track of whether+-- an unsafe block is compiler generated.+data Unsafety = Unsafe | Normal deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Data, Generic, NFData)++-- | A variant in Rust is a constructor (either in a 'StructItem', 'Union', or 'Enum') which groups+-- together fields (@syntax::ast::Variant@). In the case of a unit variant, there can also be an+-- explicit discriminant expression.+data Variant a = Variant Ident [Attribute a] (VariantData a) (Maybe (Expr a)) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (Variant a) where spanOf (Variant _ _ _ _ s) = spanOf s++-- | Main payload in a 'Variant' (@syntax::ast::VariantData@).+--+-- Examples:+--+-- @+-- enum Foo {+-- // Struct variant+-- Bar { x: f64 },+--+-- // Tuple variant+-- Baz(i32, i32),+--+-- // Unit variant+-- Qux,+-- }+-- @+data VariantData a+ = StructD [StructField a] a -- ^ Struct variant+ | TupleD [StructField a] a -- ^ Tuple variant+ | UnitD a -- ^ Unit variant+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (VariantData a) where+ spanOf (StructD _ s) = spanOf s+ spanOf (TupleD _ s) = spanOf s+ spanOf (UnitD s) = spanOf s++-- | Paths used in 'Use' items (@ast::syntax::UseTree@).+--+-- Examples:+--+-- @+-- // Simple use paths+-- use foo::bar::baz as quux;+-- use foo::bar::baz;+--+-- // Glob use paths+-- use foo::bar::*;+--+-- // Nested use paths+-- use foo::bar::{a, b, c::quux as d}+-- @+data UseTree a+ -- | Simple path, optionally ending in an @as@+ = UseTreeSimple (Path a) (Maybe Ident) a+ -- | Path ending in a glob pattern+ | UseTreeGlob (Path a) a+ -- | Path ending in a list of more paths + | UseTreeNested (Path a) [UseTree a] a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (UseTree a) where+ spanOf (UseTreeSimple _ _ s) = spanOf s+ spanOf (UseTreeGlob _ s) = spanOf s+ spanOf (UseTreeNested _ _ s) = spanOf s++-- | The visibility modifier dictates from where one can access something+-- (@ast::syntax::Visibility@). [RFC about adding restricted+-- visibility](https://github.com/rust-lang/rfcs/blob/master/text/1422-pub-restricted.md)+data Visibility a+ = PublicV -- ^ @pub@ is accessible from everywhere + | CrateV -- ^ @pub(crate)@ is accessible from within the crate+ | RestrictedV (Path a) -- ^ for some path @p@, @pub(p)@ is visible at that path+ | InheritedV -- ^ if no visbility is specified, this is the default+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++-- | A @where@ clause in a definition, where one can apply a series of constraints to the types+-- introduced and used by a 'Generic' clause (@syntax::ast::WhereClause@). In many cases, @where@ +-- is the /only/ way to express certain bounds (since those bounds may not be immediately on a type+-- defined in the generic, but on a type derived from types defined in the generic).+--+-- Note that while 'WhereClause' is a field of 'Generic', not all uses of generics are coupled with+-- a where clause. In those cases, we leave the list of predicates empty.+--+-- Example: @where Option\<T\>: Debug@ as in+--+-- @+-- impl\<T\> PrintInOption for T where Option\<T\>: Debug { }+-- @+data WhereClause a = WhereClause [WherePredicate a] a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (WhereClause a) where spanOf (WhereClause _ s) = spanOf s++instance Sem.Semigroup a => Sem.Semigroup (WhereClause a) where+ WhereClause wp1 x1 <> WhereClause wp2 x2 = WhereClause (wp1 ++ wp2) (x1 <> x2)++instance (Sem.Semigroup a, Monoid a) => Monoid (WhereClause a) where+ mappend = (<>)+ mempty = WhereClause [] mempty++-- | An individual predicate in a 'WhereClause' (@syntax::ast::WherePredicate@).+data WherePredicate a+ -- | type bound (@syntax::ast::WhereBoundPredicate@) (example: @for\<\'c\> Foo: Send+Clone+\'c@)+ = BoundPredicate [LifetimeDef a] (Ty a) [TyParamBound a] a+ -- | lifetime predicate (@syntax::ast::WhereRegionPredicate@) (example: @\'a: \'b+\'c@)+ | RegionPredicate (Lifetime a) [Lifetime a] a+ -- | equality predicate (@syntax::ast::WhereEqPredicate@) (example: @T=int@). Note that this is+ -- not currently supported.+ | EqPredicate (Ty a) (Ty a) a+ deriving (Eq, Ord, Functor, Show, Typeable, Data, Generic, Generic1, NFData)++instance Located a => Located (WherePredicate a) where+ spanOf (BoundPredicate _ _ _ s) = spanOf s+ spanOf (RegionPredicate _ _ s) = spanOf s+ spanOf (EqPredicate _ _ s) = spanOf s+
+ src/Language/Rust/Syntax/Token.hs view
@@ -0,0 +1,376 @@+{-|+Module : Language.Rust.Syntax.Token+Description : Token definitions+Copyright : (c) Alec Theriault, 2017-2018+License : BSD-style+Maintainer : alec.theriault@gmail.com+Stability : experimental+Portability : GHC++Contains roughly the same stuff as @syntax::parse::token@ - data definitions for tokens.+-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}++module Language.Rust.Syntax.Token (+ Token(..),+ spaceNeeded,+ Space(..),+ Delim(..),+ LitTok(..),+ AttrStyle(..),+) where++import GHC.Generics ( Generic )++import Control.DeepSeq ( NFData )+import Data.Data ( Data )+import Data.Maybe ( fromMaybe )+import Data.Typeable ( Typeable )++import Language.Rust.Data.Ident ( Ident(name), Name )+import Language.Rust.Data.Position ( Span )+import Language.Rust.Syntax.AST ( Nonterminal, AttrStyle(..) )++-- | A general token (based on @syntax::parse::token::Token@).+--+-- Unlike its @libsyntax@ counterpart, 'Token' has folded in @syntax::parse::token::BinOpToken@+-- and @syntax::parse::token::BinOpEqToken@ as regular tokens.+data Token+ -- Single character expression-operator symbols.+ = Equal -- ^ @=@ token + | Less -- ^ @<@ token + | Greater -- ^ @>@ token + | Ampersand -- ^ @&@ token + | Pipe -- ^ @|@ token + | Exclamation -- ^ @!@ token + | Tilde -- ^ @~@ token + | Plus -- ^ @+@ token + | Minus -- ^ @-@ token + | Star -- ^ @*@ token + | Slash -- ^ @/@ token + | Percent -- ^ @%@ token + | Caret -- ^ @^@ token + + -- Multi character expression-operator symbols+ | GreaterEqual -- ^ @>=@ token+ | GreaterGreaterEqual -- ^ @>>=@ token+ | AmpersandAmpersand -- ^ @&&@ token+ | PipePipe -- ^ @||@ token+ | LessLess -- ^ @<<@ token+ | GreaterGreater -- ^ @>>@ token+ | EqualEqual -- ^ @==@ token+ | NotEqual -- ^ @!=@ token+ | LessEqual -- ^ @<=@ token+ | LessLessEqual -- ^ @<<=@ token+ | MinusEqual -- ^ @-=@ token+ | AmpersandEqual -- ^ @&=@ token+ | PipeEqual -- ^ @|=@ token+ | PlusEqual -- ^ @+=@ token+ | StarEqual -- ^ @*=@ token+ | SlashEqual -- ^ @/=@ token+ | CaretEqual -- ^ @^=@ token+ | PercentEqual -- ^ @%=@ token+ + -- Structural symbols + | At -- ^ @\@@ token+ | Dot -- ^ @.@ token+ | DotDot -- ^ @..@ token+ | DotDotEqual -- ^ @..=@ token+ | DotDotDot -- ^ @...@ token+ | Comma -- ^ @,@ token+ | Semicolon -- ^ @;@ token+ | Colon -- ^ @:@ token+ | ModSep -- ^ @::@ token+ | RArrow -- ^ @->@ token+ | LArrow -- ^ @<-@ token+ | FatArrow -- ^ @=>@ token+ | Pound -- ^ @#@ token+ | Dollar -- ^ @$@ token+ | Question -- ^ @?@ token+ + -- Embedded code+ | EmbeddedCode String -- ^ @${@ ... @}@ token containing embedded code+ | EmbeddedIdent String -- ^ @${@ ... @}@ token containing embedded code++ -- Delimiters+ | OpenDelim !Delim -- ^ One of @(@, @[@, @{@+ | CloseDelim !Delim -- ^ One of @)@, @]@, @}@+ + -- Literals+ | LiteralTok LitTok (Maybe Name) -- ^ a literal token with an optional suffix (something like @i32@)+ + -- Name components+ | IdentTok Ident -- ^ an arbitrary identifier (something like @x@ or @foo@ or @and_then@)+ | LifetimeTok Ident -- ^ a lifetime (something like @\'a@ or @\'static@)+ | Space Space Name -- ^ whitespace+ | Doc String !AttrStyle !Bool+ -- ^ doc comment with its contents, whether it is outer/inner, and whether it is inline or not+ | Shebang -- ^ @#!@ shebang token+ | Eof -- ^ end of file token+ + -- NOT PRODUCED IN TOKENIZATION!!+ | Interpolated (Nonterminal Span) -- ^ can be expanded into several tokens in macro-expansion+ deriving (Eq, Ord, Data, Typeable, Generic, NFData)++-- | Rust is whitespace independent. Short of providing space between tokens, whitespace is all the+-- same to the parser.+data Space+ = Whitespace -- ^ usual white space: @[\\ \\t\\n\\f\\v\\r]+@+ | Comment -- ^ comment (either inline or not)+ deriving (Eq, Ord, Show, Enum, Bounded, Data, Typeable, Generic, NFData)++-- TODO: BANISH NoDelim! (or rather: distinguish DelimToken from Delim, as rustc does)+-- | A delimiter token (@syntax::parse::token::DelimToken@).+data Delim+ = Paren -- ^ round parenthesis: @(@ or @)@+ | Bracket -- ^ square bracket: @[@ or @]@+ | Brace -- ^ curly brace: @{@ or @}@+ | NoDelim -- ^ empty delimiter+ deriving (Eq, Ord, Enum, Bounded, Show, Data, Typeable, Generic, NFData)++-- | A literal token (@syntax::parse::token::Lit@)+data LitTok+ = ByteTok Name -- ^ byte+ | CharTok Name -- ^ character+ | IntegerTok Name -- ^ integral literal (could have type @i32@, @int@, @u128@, etc.)+ | FloatTok Name -- ^ floating point literal (could have type @f32@, @f64@, etc.)+ | StrTok Name -- ^ string literal+ | StrRawTok Name !Int -- ^ raw string literal and the number of @#@ marks around it+ | ByteStrTok Name -- ^ byte string literal+ | ByteStrRawTok Name !Int -- ^ raw byte string literal and the number of @#@ marks around it+ deriving (Eq, Ord, Show, Data, Typeable, Generic, NFData)+++-- | Check whether a space is needed between two tokens to avoid confusion.+spaceNeeded :: Token -> Token -> Bool+-- conflicts with 'GreaterEqual'+spaceNeeded Greater Equal = True+spaceNeeded Greater EqualEqual = True+spaceNeeded Greater FatArrow = True++-- conflicts with 'GreaterGreaterEqual'+spaceNeeded Greater GreaterEqual = True+spaceNeeded GreaterGreater Equal = True+spaceNeeded GreaterGreater EqualEqual = True +spaceNeeded GreaterGreater FatArrow = True++-- conflicts with 'AmpersandAmpersand'+spaceNeeded Ampersand Ampersand = True+spaceNeeded Ampersand AmpersandAmpersand = True+spaceNeeded Ampersand AmpersandEqual = True++-- conflicts with 'PipePipe'+spaceNeeded Pipe Pipe = True+spaceNeeded Pipe PipePipe = True+spaceNeeded Pipe PipeEqual = True++-- conflicts with 'LessLess'+spaceNeeded Less Less = True+spaceNeeded Less LessLess = True+spaceNeeded Less LessLessEqual = True+spaceNeeded Less LArrow = True++-- conflicts with 'GreaterGreater'+spaceNeeded Greater Greater = True+spaceNeeded Greater GreaterGreater = True+spaceNeeded Greater GreaterGreaterEqual = True++-- conflicts with 'EqualEqual'+spaceNeeded Equal Equal = True+spaceNeeded Equal EqualEqual = True+spaceNeeded Equal FatArrow = True++-- conflicts with 'NotEqual'+spaceNeeded Exclamation Equal = True+spaceNeeded Exclamation EqualEqual = True+spaceNeeded Exclamation FatArrow = True++-- conflicts with 'LessEqual'+spaceNeeded Less Equal = True+spaceNeeded Less EqualEqual = True+spaceNeeded Less FatArrow = True++-- conflicts with 'LessLessEqual'+spaceNeeded Less LessEqual = True+spaceNeeded LessLess Equal = True+spaceNeeded LessLess EqualEqual = True+spaceNeeded LessLess FatArrow = True++-- conflicts with 'MinusEqual'+spaceNeeded Minus Equal = True+spaceNeeded Minus EqualEqual = True+spaceNeeded Minus FatArrow = True++-- conflicts with 'AmpersandEqual'+spaceNeeded Ampersand Equal = True+spaceNeeded Ampersand EqualEqual = True+spaceNeeded Ampersand FatArrow = True++-- conflicts with 'PipeEqual'+spaceNeeded Pipe Equal = True+spaceNeeded Pipe EqualEqual = True+spaceNeeded Pipe FatArrow = True++-- conflicts with 'PlusEqual'+spaceNeeded Plus Equal = True+spaceNeeded Plus EqualEqual = True+spaceNeeded Plus FatArrow = True++-- conflicts with 'StarEqual'+spaceNeeded Star Equal = True+spaceNeeded Star EqualEqual = True+spaceNeeded Star FatArrow = True++-- conflicts with 'SlashEqual'+spaceNeeded Slash Equal = True+spaceNeeded Slash EqualEqual = True+spaceNeeded Slash FatArrow = True++-- conflicts with 'CaretEqual'+spaceNeeded Caret Equal = True+spaceNeeded Caret EqualEqual = True+spaceNeeded Caret FatArrow = True++-- conflicts with 'PercentEqual'+spaceNeeded Percent Equal = True+spaceNeeded Percent EqualEqual = True+spaceNeeded Percent FatArrow = True++-- conflicts with 'DotDot'+spaceNeeded Dot Dot = True+spaceNeeded Dot DotDot = True+spaceNeeded Dot DotDotDot = True++-- conflicts with 'DotDotDot'+spaceNeeded DotDot Dot = True+spaceNeeded DotDot DotDot = True+spaceNeeded DotDot DotDotDot = True++-- conflicts with 'DotDotEqual'+spaceNeeded DotDot Equal = True+spaceNeeded DotDot EqualEqual = True+spaceNeeded DotDot FatArrow = True++-- conflicts with 'ModSep'+spaceNeeded Colon Colon = True+spaceNeeded Colon ModSep = True++-- conflicts with 'RArrow'+spaceNeeded Minus Greater = True+spaceNeeded Minus GreaterGreater = True+spaceNeeded Minus GreaterEqual = True+spaceNeeded Minus GreaterGreaterEqual = True++-- conflicts with 'LArrow'+spaceNeeded Less Minus = True+spaceNeeded Less MinusEqual = True+spaceNeeded Less RArrow = True++-- conflicts with 'FatArrow'+spaceNeeded Equal Greater = True+spaceNeeded Equal GreaterGreater = True+spaceNeeded Equal GreaterEqual = True+spaceNeeded Equal GreaterGreaterEqual = True++-- conflicts with 'LiteralTok'+spaceNeeded LiteralTok{} IdentTok{} = True ++-- conflicts with 'IdentTok'+spaceNeeded IdentTok{} IdentTok{} = True++-- conflicts with 'Shebang'+spaceNeeded Pound Exclamation = True+spaceNeeded Pound NotEqual = True++-- there are no other conflicts+spaceNeeded _ _ = False+++-- | This instance is only for error messages and debugging purposes.+instance Show Token where+ -- Single character expression-operator symbols.+ show Equal = "="+ show Less = "<"+ show Greater = ">"+ show Ampersand = "&"+ show Pipe = "|"+ show Exclamation = "!"+ show Tilde = "~"+ show Plus = "+"+ show Minus = "-"+ show Star = "*"+ show Slash = "/"+ show Percent = "%"+ -- Multi character eexpression-operator symbols+ show GreaterEqual = ">="+ show GreaterGreaterEqual = ">>="+ show AmpersandAmpersand = "&&"+ show PipePipe = "||"+ show LessLess = "<<"+ show GreaterGreater = ">>"+ show EqualEqual = "=="+ show NotEqual = "!="+ show LessEqual = "<="+ show LessLessEqual = "<<="+ show MinusEqual = "-="+ show AmpersandEqual = "&="+ show PipeEqual = "|="+ show PlusEqual = "+="+ show StarEqual = "*="+ show SlashEqual = "/="+ show CaretEqual = "^="+ show PercentEqual = "%="+ show Caret = "^"+ -- Structural symbols+ show At = "@"+ show Dot = "."+ show DotDot = ".."+ show DotDotDot = "..."+ show DotDotEqual = "..="+ show Comma = ","+ show Semicolon = ";"+ show Colon = ":"+ show ModSep = "::"+ show RArrow = "->"+ show LArrow = "<-"+ show FatArrow = "=>"+ show Pound = "#"+ show Dollar = "$"+ show Question = "?"+ -- Embedded code+ show (EmbeddedCode s) = "${e|" ++ s ++ "|}"+ show (EmbeddedIdent s) = "${i|" ++ s ++ "|}"+ -- Delimiters, eg. @{@, @${@, @]@, @(@+ show (OpenDelim Paren) = "("+ show (OpenDelim Bracket) = "["+ show (OpenDelim Brace) = "{"+ show (OpenDelim NoDelim) = ""+ show (CloseDelim Paren) = ")"+ show (CloseDelim Bracket) = "]"+ show (CloseDelim Brace) = "}"+ show (CloseDelim NoDelim) = ""+ -- Literals+ show (LiteralTok (ByteTok n) s) = "b'" ++ n ++ "'" ++ fromMaybe "" s+ show (LiteralTok (CharTok n) s) = "'" ++ n ++ "'" ++ fromMaybe "" s+ show (LiteralTok (IntegerTok n) s) = n ++ fromMaybe "" s+ show (LiteralTok (FloatTok n) s) = n ++ fromMaybe "" s+ show (LiteralTok (StrTok n) s) = "\"" ++ n ++ "\"" ++ fromMaybe "" s+ show (LiteralTok (StrRawTok n i) s) = "r" ++ replicate i '#' ++ "\"" ++ n ++ "\"" ++ replicate i '#' ++ fromMaybe "" s+ show (LiteralTok (ByteStrTok n) s) = "b\"" ++ n ++ "\"" ++ fromMaybe "" s+ show (LiteralTok (ByteStrRawTok n i) s) = "br" ++ replicate i '#' ++ "\"" ++ n ++ "\"" ++ replicate i '#' ++ fromMaybe "" s+ -- Name components+ show (IdentTok i) = show $ name i+ show (LifetimeTok l) = "'" ++ show l+ show (Space Whitespace _) = "<whitespace>"+ show (Space Comment n) = "/*" ++ show n ++ " */"+ show (Doc d Inner True) = "/*!" ++ d ++ "*/"+ show (Doc d Outer True) = "/**" ++ d ++ "*/"+ show (Doc d Inner False) = "//!" ++ d+ show (Doc d Outer False) = "///" ++ d+ show Shebang = "#!"+ show Eof = "<EOF>"+ -- Macro related + show Interpolated{} = "<Interpolated>"+
+ src/Language/Rust/Syntax/Token.hs-boot view
@@ -0,0 +1,38 @@+-- .hs-boot files play badly with associated type families like 'Rep'+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-missing-methods #-}+#endif++module Language.Rust.Syntax.Token where++import GHC.Generics (Generic)+import Data.Data (Data)+-- import Data.Typeable (Typeable)+import Control.DeepSeq (NFData)++data LitTok++data Token+instance Eq Token+instance Ord Token+instance Show Token+instance Data Token+-- instance Typeable Token+instance Generic Token+instance NFData Token++data Delim+instance Eq Delim+instance Ord Delim+instance Data Delim+-- instance Typeable Delim+instance Generic Delim+instance Show Delim+instance NFData Delim++data Space+instance NFData Space+instance Eq Space+instance Ord Space+
+ test/parser/Main.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, TypeFamilies, QuasiQuotes+ , DataKinds, ScopedTypeVariables, OverloadedStrings, TypeSynonymInstances+ , FlexibleInstances, UndecidableInstances, FlexibleContexts, TemplateHaskell+ , DeriveDataTypeable, BangPatterns, UnicodeSyntax #-}+module Main where+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit+--import Test.Framework.Providers.QuickCheck2+--import Test.QuickCheck (Property, quickCheck, (==>))++import Language.Floorplan.Syntax+import Language.Floorplan.Token+import qualified Language.Floorplan.Parser as P+import System.IO (openFile, IOMode(..), hGetContents)+import qualified Debug.Trace as D+import Data.List (sort)++import Language.Rust.Pretty (pretty)+import Language.Floorplan.Core.Compiler+import qualified Language.Floorplan.Rust as R++{-+testTokenizes fn = testCase fn $ do+ fd <- openFile fn ReadMode+ contents <- hGetContents fd+ let !xs = show $ P.tokenize contents+ return ()++testParses fn = testCase fn $ do+ fd <- openFile fn ReadMode+ contents <- hGetContents fd+ let !xs = P.parseFloorplanDemarcsGLR fn 0 0 contents+ return ()++testParsesExp fn expected = testCase fn $ do+ fd <- openFile fn ReadMode+ contents <- hGetContents fd+ let xs = P.parseFloorplanDemarcsGLR fn 0 0 contents+ assertEqual "Not equal" xs expected+-}++-- Happy parser generator versions:++readme fn = do+ fd <- openFile fn ReadMode+ hGetContents fd++mkTest fn cont = testCase fn $ readme fn >>= cont++testTokenizes fn = mkTest fn $ \contents -> do+ let !xs = show $ scanTokens contents+ return ()++testParses fn = mkTest fn $ \contents -> do+ let !xs = P.parseLayers contents+ return ()++testGrafts fn = mkTest fn $ \contents -> do+ let !xs = P.parseLayers contents+ let !ys = map (grafting xs) xs+ countGrafting ys @?= 0+ return ()++testParsesExp fn expected = mkTest fn $ \contents ->+ expected @=? P.parseLayers contents++test_b2i =+ assertEqual "incorrect binary value"+ (bin2int "0b1010")+ 10++test_b2i' =+ assertEqual "incorrect binary value"+ (bin2int "0b000000")+ 0++tokenizeSuite = testGroup "tokenization suite"+ [ testTokenizes "examples/empty.flp"+ ]++parseSuite = testGroup "parsing suite"+ [ testParses "examples/immix/layout.flp"+ , testParses "examples/empty.flp"+ , testParses "examples/seq.flp"+ , testParses "examples/enum.flp"+ , testParses "examples/union.flp"+ , testParses "examples/layer.flp"+ , testParses "examples/bits.flp"+ , testParses "examples/arith_id.flp"+ , testParses "examples/arith_power.flp"+ , testParses "examples/bump.flp"+ , testParses "examples/dynamic_prim.flp"+ , testParses "examples/dyn_choice.flp"+ , testParses "examples/dyn_seq.flp"+-- , testNotParses "examples/enum_bad0.flp"+ , testParses "examples/map_bits.flp"+ , testParses "examples/named_ref.flp"+ , testParses "examples/nested.flp"+ , testParses "examples/nested_union.flp"+ , testParses "examples/app.flp"+ , testParses "examples/parens.flp"+ , testParsesExp "examples/arith.flp" theLayer+ ]++theLayer =+ [ Layer+ { name = "Arith"+ , formals = []+ , magnitude = Just (SizeLit (Just (Lit 7)) Byte)+ , alignment = Nothing+ , magAlign = Nothing+ , contains = []+ , rhs = Blob (SizeLit+ (Just (Plus+ (Times (Div (Lit 4) (Lit 2))+ (Lit 3))+ (Lit 1)))+ Byte+ )+ }+ ]++graftSuite = testGroup "grafting suite"+ [ testGrafts "examples/immix/layout.flp"+ , testCase "empty unique" $ [] @=? (checkUniqNames theLayer)+ , mkTest "examples/uniq_fail.flp" $ \c -> (sort ["foo", "Outer"]) @=? (sort $ checkUniqNames (P.parseLayers c))+ ]++testCompiles fn = mkTest fn $ \contents -> do+ let !xs = P.parseLayers contents+ let !ys = map (grafting xs) xs+ countGrafting ys @?= 0+ let !zs = D.traceShowId $ map compile ys+ let !rust = D.traceShowId $ R.genRust zs+ let !_ = D.traceShowId $ pretty rust+ return ()++compileSuite = testGroup "compiling suite"+ [ testCase "enumBytes A" $ enumBytes (take 0 $ repeat "") @?= 0 -- Null enum requires no space.+ , testCase "enumBytes B" $ enumBytes (take 1 $ repeat "") @?= 1 -- Singletone requires space.+ , testCase "enumBytes C" $ enumBytes (take 128 $ repeat "") @?= 1 -- Most enums take 1 bytes.+ , testCase "enumBytes D" $ enumBytes (take 256 $ repeat "") @?= 1 -- Including this one.+ , testCase "enumBytes E" $ enumBytes (take 257 $ repeat "") @?= 2 -- But not this one.+ , testCase "enumBytes F" $ enumBytes (take (256*256) $ repeat "") @?= 2 -- Not this one either.+ , testCase "enumBytes G" $ enumBytes (take (256*256 + 1) $ repeat "") @?= 3 -- And definitely not this one.+ , testCase "enumBytes H" $ enumBytes (take (256*256*256 + 1) $ repeat "") @?= 4 -- And so on.+ , testCompiles "examples/immix/layout.flp"+ , testCase "delta_bytes round small" $ delta_bytes (SizeLit (Just $ Lit $ 8*3-1) Bit) @?= 3+ , testCase "delta_bytes no rounding" $ delta_bytes (SizeLit (Just $ Lit $ 8*3 ) Bit) @?= 3+ , testCase "delta_bytes round large" $ delta_bytes (SizeLit (Just $ Lit $ 8*3+1) Bit) @?= 4+ ]++main :: IO ()+main = defaultMainWithOpts+ [ testCase "Binary conversion" test_b2i+ , testCase "Binary conversion" test_b2i'+ , tokenizeSuite+ , parseSuite+ , graftSuite+ , compileSuite+ ] mempty+