Syntax.hs

module Zwirn.Language.Syntax where

{-
    Syntax.hs - definition of the zwirn language,
    inspired by tidals mini-notation
    Copyright (C) 2023, Martin Gius

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Data.Text (Text)
import Zwirn.Language.Location

type Var = Text

type LocVar = Located Var

data EnumKind = Cord | Choice | Run | Alt deriving (Eq, Show)

type LocTerm = Located Term

-- sugary representation of patterns
data Term
  = TVar !Var
  | TText !Text
  | TNum !Text
  | TMacro !Text
  | TRest
  | TBracket LocTerm
  | TSeq [LocTerm]
  | TStack [LocTerm]
  | TAlt [LocTerm]
  | TChoice !Int [LocTerm]
  | TPoly LocTerm LocTerm
  | TApp LocTerm LocTerm
  | TInfix LocTerm LocVar LocTerm
  | TSectionL LocTerm LocVar
  | TSectionR LocVar LocTerm
  | TLambda [Var] LocTerm
  | TIfThenElse LocTerm LocTerm (Maybe LocTerm)
  | TRepeat LocTerm (Maybe Int)
  | TEnum EnumKind LocTerm LocTerm
  | TEnumThen EnumKind LocTerm LocTerm LocTerm
  deriving (Eq, Show)

data Command
  = TypeCommand LocTerm
  | ShowCommand LocTerm
  | InfoCommand !Text
  | SetCommand !Text
  | UnsetCommand !Text
  | LoadCommand !Text
  | ResetConfigCommand
  | ShowConfigPathCommand
  | ResetEnvCommand
  | StatusCommand
  | EnvCommand
  deriving (Eq, Show)

data Definition = Definition !Text [Text] LocTerm
  deriving (Eq, Show)

data DynamicDefinition = DynamicDefinition !Text LocTerm
  deriving (Eq, Show)

data MacroDefinition = MacroDefinition !Text LocTerm
  deriving (Eq, Show)

data Syntax
  = Exec LocTerm
  | Def (Located Definition)
  | DynDef (Located DynamicDefinition)
  | MacroDef (Located MacroDefinition)
  | Command (Located Command)
  deriving (Eq, Show)

data Associativity
  = NonA
  | LeftA
  | RightA
  deriving (Eq, Show)

type Precedence = Int

data Fixity
  = Fixity Associativity !Precedence
  deriving (Eq, Show)

type Declaration = (Var, Fixity)

subterms :: Term -> [LocTerm]
subterms (TVar _) = []
subterms (TNum _) = []
subterms (TText _) = []
subterms (TMacro _) = []
subterms TRest = []
subterms (TBracket t) = [t]
subterms (TLambda _ t) = [t]
subterms (TRepeat t _) = [t]
subterms (TSeq ts) = ts
subterms (TStack ts) = ts
subterms (TAlt ts) = ts
subterms (TChoice _ ts) = ts
subterms (TPoly x y) = [x, y]
subterms (TApp x y) = [x, y]
subterms (TInfix x _ y) = [x, y]
subterms (TSectionR _ t) = [t]
subterms (TSectionL t _) = [t]
subterms (TEnum _ x y) = [x, y]
subterms (TEnumThen _ x y z) = [x, y, z]
subterms (TIfThenElse x y (Just z)) = [x, y, z]
subterms (TIfThenElse x y Nothing) = [x, y]

-- mapTerm :: (Position -> Text -> Term -> a) -> Term -> [a]
-- mapTerm f t@(TVar pos x) = [f pos x t]
-- mapTerm f t@(TNum pos x) = [f pos x t]
-- mapTerm f t@(TText pos x) = [f pos x t]
-- mapTerm f t@(TRest pos) = [f pos (pack "~") t]
-- mapTerm f (TSeq ts) = concatMap (mapTerm f) ts
-- mapTerm f (TAlt ts) = concatMap (mapTerm f) ts
-- mapTerm f (TStack ts) = concatMap (mapTerm f) ts
-- mapTerm f (TChoice _ ts) = concatMap (mapTerm f) ts
-- mapTerm f (TCase x (Just y) ts) = concatMap (mapTerm f) ([x, y] ++ map snd ts)
-- mapTerm f (TCase x Nothing ts) = concatMap (mapTerm f) (x : map snd ts)
-- mapTerm f (TRepeat t _) = mapTerm f t
-- mapTerm f (TLambda _ t) = mapTerm f t
-- mapTerm f (TBracket t) = mapTerm f t
-- mapTerm f t@(TInfix x n pos y) = [f pos n t] ++ mapTerm f x ++ mapTerm f y
-- mapTerm f t@(TSectionR n pos x) = f pos n t : mapTerm f x
-- mapTerm f t@(TSectionL x n pos) = f pos n t : mapTerm f x
-- mapTerm f (TPoly x y) = mapTerm f x ++ mapTerm f y
-- mapTerm f (TEnum _ x y) = mapTerm f x ++ mapTerm f y
-- mapTerm f (TEnumThen _ x y z) = mapTerm f x ++ mapTerm f y ++ mapTerm f z
-- mapTerm f (TIfThenElse x y (Just z)) = mapTerm f x ++ mapTerm f y ++ mapTerm f z
-- mapTerm f (TIfThenElse x y Nothing) = mapTerm f x ++ mapTerm f y
-- mapTerm f (TApp x y) = mapTerm f x ++ mapTerm f y

-- mapAction :: (Term -> a) -> Action -> Maybe a
-- mapAction f (StreamAction _ t) = Just $ f t
-- mapAction f (StreamSet _ t) = Just $ f t
-- mapAction f (StreamOnce t) = Just $ f t
-- mapAction f (Type t) = Just $ f t
-- mapAction f (Show t) = Just $ f t
-- mapAction f (Def (Let _ _ t)) = Just $ f t
-- mapAction _ _ = Nothing