53 lines
1.5 KiB
Haskell
53 lines
1.5 KiB
Haskell
{-# LANGUAGE PartialTypeSignatures #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Gyehoek.Sexp
|
|
( let_
|
|
, nonempty
|
|
)
|
|
where
|
|
|
|
import Data.Text (Text)
|
|
import Language.SexpGrammar as Sexp hiding (List)
|
|
import Language.SexpGrammar.Generic
|
|
import Data.InvertibleGrammar.Base qualified as IG
|
|
import Data.InvertibleGrammar.Base ((:-)((:-)))
|
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
|
import Data.List (List)
|
|
import GHC.Generics
|
|
|
|
|
|
nonempty :: SexpGrammar a -> SexpGrammar (NonEmpty a)
|
|
nonempty a =
|
|
list (el a >>> rest a) >>>
|
|
pair >>> iso (uncurry (:|)) (\(x :| xs) -> (x, xs))
|
|
|
|
let_
|
|
:: (forall t. Grammar Position (Sexp :- t) (a :- t))
|
|
-> (forall t. Grammar Position (Sexp :- t) (b :- t))
|
|
-> Grammar Position (Sexp :- (NonEmpty (a, b) :- t1)) t2
|
|
-> Grammar Position (Sexp :- t1) t2
|
|
let_ name rhs e = list (el (sym "let") >>> el bindings >>> el e)
|
|
where
|
|
-- bindings :: Grammar Position (Sexp :- _) (List (_, _) :- _)
|
|
bindings = nonempty binding
|
|
binding :: Grammar Position (Sexp :- t) ((_, _) :- t)
|
|
binding = list (el name >>> el rhs) >>> pair
|
|
|
|
data DotList a = MkDotList (NonEmpty a) a
|
|
deriving (Show, Generic)
|
|
|
|
dotlist :: (forall t. Grammar Position (Sexp :- t) (a :- t)) -> _
|
|
dotlist x = list $ rest $ coproduct
|
|
[ x >>> _
|
|
]
|
|
|
|
lambda
|
|
:: (forall t. Grammar Position (Sexp :- t) (a :- t))
|
|
-> Grammar Position (Sexp :- List a :- t1) t2
|
|
-> Grammar Position (Sexp :- t1) t2
|
|
lambda name e = list $
|
|
el (sym "lambda")
|
|
>>> el (list $ rest name)
|
|
>>> el e
|