HasLocation

HasLocation

src/Rlp/Parse.y

@@ -72,32 +72,21 @@ import Compiler.Types
 %%
 
 StandaloneProgram   :: { Program RlpcPs }
-StandaloneProgram   : '{' Decls  '}'        { undefined }
-                    | VL  DeclsV VR         { undefined }
+StandaloneProgram   : layout0(Decl)         { Program $1 }
 
 StandaloneExpr      :: { Expr RlpcPs }
-                    : VL Expr VR            { undefined }
+                    : VL Expr VR            { $2 }
 
 VL  :: { () }
-VL  : vlbrace       { undefined }
+VL  : vlbrace       { () }
 
 VR  :: { () }
-VR  : vrbrace       { undefined }
-    | error         { undefined }
+VR  : vrbrace       { () }
+    | error         { () }
 
-Decls               :: { [Decl RlpcPs] }
-Decls               : Decl ';' Decls        { undefined }
-                    | Decl ';'              { undefined }
-                    | Decl                  { undefined }
-
-DeclsV              :: { [Decl RlpcPs] }
-DeclsV              : Decl VS DeclsV        { undefined }
-                    | Decl VS               { undefined }
-                    | Decl                  { undefined }
-
-VS                  :: { Located RlpToken }
-VS                  : ';'                   { undefined }
-                    | vsemi                 { undefined }
+VS                  :: { () }
+VS                  : ';'                   { () }
+                    | vsemi                 { () }
 
 Decl        :: { Decl RlpcPs }
             : FunDecl                   { undefined }
@@ -148,7 +137,7 @@ TypeApp     :: { Ty RlpcPs }
             | TypeApp Type1             { undefined }
 
 FunDecl     :: { Decl RlpcPs }
-FunDecl     : Var Params '=' Expr       { undefined }
+FunDecl     : Var Params '=' Expr       { FunD $1 $2 $4 Nothing }
 
 Params      :: { [Pat RlpcPs] }
 Params      : {- epsilon -}             { undefined }
@@ -199,21 +188,21 @@ Alt         :: { Alt RlpcPs }
             : Pat '->' Expr                 { undefined }
 
 -- layout0(p : β) :: [β]
-layout0(p)  : '{' layout_list0(';',p) '}'   { undefined }
-            | VL  layout_list0(VS,p)  VR    { undefined }
+layout0(p)  : '{' layout_list0(';',p) '}'   { $2 }
+            | VL  layout_list0(VS,p)  VR    { $2 }
 
 -- layout_list0(sep : α, p : β) :: [β]
-layout_list0(sep,p) : p                          { undefined }
-                    | layout_list1(sep,p) sep p  { undefined }
-                    | {- epsilon -}              { undefined }
+layout_list0(sep,p) : p                          { [$1] }
+                    | layout_list1(sep,p) sep p  { $1 `snoc` $3 }
+                    | {- epsilon -}              { [] }
 
 -- layout1(p : β) :: [β]
-layout1(p)  : '{' layout_list1(';',p) '}'   { undefined }
-            | VL  layout_list1(VS,p) VR     { undefined }
+layout1(p)  : '{' layout_list1(';',p) '}'   { $2 }
+            | VL  layout_list1(VS,p) VR     { $2 }
 
 -- layout_list1(sep : α, p : β) :: [β]
-layout_list1(sep,p) : p                          { undefined }
-                    | layout_list1(sep,p) sep p  { undefined }
+layout_list1(sep,p) : p                          { [$1] }
+                    | layout_list1(sep,p) sep p  { $1 `snoc` $3 }
 
 Binding     :: { Binding RlpcPs }
             : Pat '=' Expr              { undefined }
@@ -230,17 +219,17 @@ InfixOp     :: { Located PsName }
 
 -- TODO: microlens-pro save me microlens-pro (rewrite this with prisms)
 Lit         :: { Lit RlpcPs }
-            : litint                    { undefined }
+            : litint                    { $1 ^. to extract
+                                              . singular _TokenLitInt
+                                              . to IntL }
 
-Var         :: { Located PsName }
+Var         :: { PsName }
 Var         : varname                   { undefined }
             | varsym                    { undefined }
 
-Con         :: { Located PsName }
+Con         :: { PsName }
             : conname                   { undefined }
 
---}
-
 {
 
 parseRlpProgR = undefined

src/Rlp/Parse/Types.hs

@@ -17,7 +17,7 @@ module Rlp.Parse.Types
     , RlpToken(..), AlexInput(..), Position(..), spanFromPos, LexerAction
     , Located(..), PsName
     -- ** Lenses
-    , aiPrevChar, aiSource, aiBytes, aiPos, posLine, posColumn
+    , _TokenLitInt, aiPrevChar, aiSource, aiBytes, aiPos, posLine, posColumn
 
     -- * Error handling
     , MsgEnvelope(..), RlpcError(..), RlpParseError(..)
@@ -53,7 +53,7 @@ data RlpcPs
 
 type instance NameP RlpcPs = PsName
 
-type PsName = Text
+type PsName = Located Text
 
 --------------------------------------------------------------------------------
 
@@ -125,6 +125,11 @@ data RlpToken
     | TokenEOF
     deriving (Show)
 
+_TokenLitInt :: Prism' RlpToken Int
+_TokenLitInt = prism TokenLitInt $ \case
+    TokenLitInt n -> Right n
+    x             -> Left x
+
 newtype P a = P {
         runP :: ParseState
              -> (ParseState, [MsgEnvelope RlpParseError], Maybe a)

src/Rlp/Syntax.hs

@@ -40,12 +40,11 @@ import Control.Comonad.Cofree
 import Data.Functor.Foldable
 import Data.Functor.Foldable.TH     (makeBaseFunctor)
 
-import Compiler.Types               (SrcSpan(..))
+import Compiler.Types               (SrcSpan(..), Located(..))
 import Core.Syntax                  qualified as Core
 import Core                         (Rec(..), HasRHS(..), HasLHS(..))
 ----------------------------------------------------------------------------------
 
-type PsName = Text
 type family NameP p
 
 data Program p = Program