rlp syntax

gonna work on typechecking now lol.......

src/Core/Syntax.hs

@@ -115,33 +115,33 @@ instance Monoid (Program b) where
 
 ----------------------------------------------------------------------------------
 
-class HasRHS s z | s -> z where
-    _rhs :: Lens' s (Expr z)
+class HasRHS s t a b | s -> a, t -> b, s b -> t, t a -> s where
+    _rhs :: Lens s t a b
 
-instance HasRHS (Alter b) b where
+instance HasRHS (Alter b) (Alter b) (Expr b) (Expr b) where
     _rhs = lens
         (\ (Alter _ _ e) -> e)
         (\ (Alter t as _) e' -> Alter t as e')
 
-instance HasRHS (ScDef b) b where
+instance HasRHS (ScDef b) (ScDef b) (Expr b) (Expr b) where
     _rhs = lens
         (\ (ScDef _ _ e) -> e)
         (\ (ScDef n as _) e' -> ScDef n as e')
 
-instance HasRHS (Binding b) b where
+instance HasRHS (Binding b) (Binding b) (Expr b) (Expr b) where
     _rhs = lens
         (\ (_ := e) -> e)
         (\ (k := _) e' -> k := e')
 
-class HasLHS s a | s -> a where
-    _lhs :: Lens' s a
+class HasLHS s t a b | s -> a, t -> b, s b -> t, t a -> s where
+    _lhs :: Lens s t a b
 
-instance HasLHS (Alter b) (AltCon, [b]) where
+instance HasLHS (Alter b) (Alter b) (AltCon, [b]) (AltCon, [b]) where
     _lhs = lens
         (\ (Alter a bs _) -> (a,bs))
         (\ (Alter _ _ e) (a',bs') -> Alter a' bs' e)
 
-instance HasLHS (ScDef b) (b, [b]) where
+instance HasLHS (ScDef b) (ScDef b) (b, [b]) (b, [b]) where
     _lhs = lens
         (\ (ScDef n as _) -> (n,as))
         (\ (ScDef _ _ e) (n',as') -> (ScDef n' as' e))

src/RLP/Syntax.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+module RLP.Syntax
+    ( RlpExpr
+    )
+    where
+----------------------------------------------------------------------------------
+import Data.Text                    (Text)
+import Lens.Micro
+import Core                         (HasRHS(..), HasLHS(..))
+----------------------------------------------------------------------------------
+
+newtype RlpProgram b = RlpProgram [Decl b]
+
+data Decl b = InfixD  InfixAssoc Int VarId
+            | FunD    VarId [Pat b] (RlpExpr b)
+            | DataD   ConId [ConId] [ConAlt]
+
+data ConAlt = ConAlt ConId [ConId]
+
+data InfixAssoc = Assoc | AssocL | AssocR
+
+data RlpExpr b = LetE  [Bind b] (RlpExpr b)
+               | VarE  VarId
+               | ConE  ConId
+               | LamE  [Pat b] (RlpExpr b)
+               | CaseE (RlpExpr b) [Alt b]
+               | IfE   (RlpExpr b) (RlpExpr b) (RlpExpr b)
+               | AppE  (RlpExpr b) (RlpExpr b)
+               | LitE  (Lit b)
+
+-- do we want guards?
+data Alt b = AltA (Pat b) (RlpExpr b)
+
+data Bind b = PatB (Pat b) (RlpExpr b)
+            | FunB VarId [Pat b] (RlpExpr b)
+
+data VarId = NameVar Text
+           | SymVar Text
+
+data ConId = NameCon Text
+           | SymCon Text
+
+data Pat b = VarP VarId
+           | LitP (Lit b)
+           | ConP ConId [Pat b]
+
+data Lit b = IntL Int
+           | CharL Char
+           | ListL [RlpExpr b]
+
+-- instance HasLHS Alt Alt Pat Pat where
+--     _lhs = lens
+--         (\ (AltA p _) -> p)
+--         (\ (AltA _ e) p' -> AltA p' e)
+
+-- instance HasRHS Alt Alt RlpExpr RlpExpr where
+--     _rhs = lens
+--         (\ (AltA _ e) -> e)
+--         (\ (AltA p _) e' -> AltA p e')