85 lines
2.1 KiB
Haskell
85 lines
2.1 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 ((:|)))
|
||
|
||
|
||
type Name = Text
|
||
|
||
data Prim = PrimAdd | PrimSub | PrimMul | PrimDiv
|
||
deriving (Show, Generic)
|
||
|
||
data Val
|
||
= ValInt Int
|
||
| ValNil
|
||
| ValPrim Prim
|
||
| ValLambda (List Name) Exp
|
||
| ValVar Name
|
||
deriving (Show, Generic)
|
||
|
||
data Exp
|
||
= ExpLet (NonEmpty (Name, Exp)) Exp
|
||
| ExpApply Exp (List Exp)
|
||
| ExpBegin (List Exp)
|
||
| ExpVal Val
|
||
deriving (Show, Generic)
|
||
|
||
|
||
|
||
nonempty :: SexpGrammar a -> SexpGrammar (NonEmpty a)
|
||
nonempty a =
|
||
list (el a >>> rest a) >>>
|
||
pair >>> iso (uncurry (:|)) (\(x :| xs) -> (x, xs))
|
||
|
||
letIso
|
||
:: (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
|
||
letIso 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
|
||
|
||
instance SexpIso Prim where
|
||
sexpIso = match
|
||
$ With (. sym "+")
|
||
$ With (. sym "-")
|
||
$ With (. sym "*")
|
||
$ With (. sym "/")
|
||
$ End
|
||
|
||
instance SexpIso Val where
|
||
sexpIso = match
|
||
$ With (. sexpIso)
|
||
$ With (. sym "nil")
|
||
$ With (. sexpIso)
|
||
$ With lam
|
||
$ With (\var -> var . symbol)
|
||
$ End
|
||
where
|
||
lam q = q . list
|
||
( el (sym "lambda")
|
||
>>> el (sexpIso @(List Name))
|
||
>>> el sexpIso )
|
||
|
||
instance SexpIso Exp where
|
||
sexpIso = match
|
||
$ With (. letIso symbol sexpIso sexpIso)
|
||
$ With (\app -> app . list (el sexpIso >>> rest sexpIso))
|
||
$ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
|
||
$ With (<<< sexpIso)
|
||
$ End
|