77 lines
1.7 KiB
Haskell
77 lines
1.7 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE PartialTypeSignatures #-}
|
|
module Gyehoek.Syntax where
|
|
|
|
import Data.Text (Text)
|
|
import Data.List (List)
|
|
import Language.SexpGrammar as Sexp hiding (List)
|
|
import Language.SexpGrammar.Generic
|
|
import GHC.Generics
|
|
import Prelude hiding ((.), id)
|
|
import Control.Category
|
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
|
import Gyehoek.Sexp qualified
|
|
|
|
|
|
type Name = Text
|
|
|
|
data Prim e
|
|
= PrimAdd e e
|
|
| PrimSub e e
|
|
| PrimMul e e
|
|
| PrimDiv e e
|
|
deriving (Show, Generic, Functor, Foldable, Traversable)
|
|
|
|
data Lit
|
|
= LitInt Int
|
|
| LitNil
|
|
| LitBool Bool
|
|
deriving (Show, Generic)
|
|
|
|
data Exp
|
|
= ExpLet (NonEmpty (Name, Exp)) Exp
|
|
| ExpApply Exp (List Exp)
|
|
| ExpBegin (List Exp)
|
|
| ExpLit Lit
|
|
| ExpPrim (Prim Exp)
|
|
| ExpLambda (List Name) Exp
|
|
| ExpVar Name
|
|
deriving (Show, Generic)
|
|
|
|
|
|
|
|
instance SexpIso a => SexpIso (Prim a) where
|
|
sexpIso = match
|
|
$ With (. binop "prim-+")
|
|
$ With (. binop "prim--")
|
|
$ With (. binop "prim-*")
|
|
$ With (. binop "prim-/")
|
|
$ End
|
|
where
|
|
binop s = list $ el (sym s) >>> el sexpIso >>> el sexpIso
|
|
|
|
instance SexpIso Lit where
|
|
sexpIso = match
|
|
$ With (. sexpIso)
|
|
$ With (. sym "nil")
|
|
$ With (. sexpIso)
|
|
$ End
|
|
|
|
instance SexpIso Exp where
|
|
sexpIso = match
|
|
$ With (. Gyehoek.Sexp.let_ symbol sexpIso sexpIso)
|
|
$ With (\app -> app . list (el sexpIso >>> rest sexpIso))
|
|
$ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
|
|
$ With (. sexpIso)
|
|
$ With (. sexpIso)
|
|
$ With (. lam)
|
|
$ With (. symbol)
|
|
$ End
|
|
where
|
|
lam = list
|
|
( el (sym "lambda")
|
|
>>> el (sexpIso @(List Name))
|
|
>>> el sexpIso )
|