[Haskell-beginners] Nullable attribute of a language grammar howto

[Larry Evans]

On 09/01/08 13:21, Daniel Fischer wrote:
> Jason beat me, but I can elaborate on the matter:
>
> Am Montag, 1. September 2008 18:22 schrieb Larry Evans:
>  
>> expr2null :: (GramExpr inp_type var_type) -> (GramNull inp_type 
>> var_type)
>> {-
>>   expr2null GramExpr
>>   returns a GramNull expression which indicates whether the GramExpr
>>   can derive the empty string.
>> -}
>>     
[snip]
>
> expr2null :: forall inp_type var_type. GramExpr inp_type var_type -> 
> GramNull inp_type var_type
>
> Cheers,
> Daniel
>   
Thanks Jason and Daniel.  It works beautifully.

Now, I'm trying to figure how to use Functor to define expr2null
(renamed to gram2null in 1st attachement).
My motivation for this goal is  I've read that  a Functor as defined
in category theory is somewhat like a homomorphism, and gram2null
is, AFAICT, a homomorphism between GramExpr adn NullExpr.

However, I can't figure how to do it.  The 2nd attachment how
an example with comments which, I hope, explains where I'm
stuck.

I've also looked at happy's sources and found no use of Functor; so,
maybe haskell's Functor is not similar to category theory's Functor.

Any help would be appreciated.

-regards,
Larry

------------------------------------------------------------------------

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSignatures #-}

{- 
Purpose:
  Algebraic specification of language grammar.
-}
module Main where

data ArithInp -- terminals in grammar.
  = Ident
  | Plus
  | Mult
  | ParenLeft
  | ParenRight
  deriving(Enum,Show)
data ArithVar -- non-terminals in grammar.
  = Term
  | Factor
  | Expr
  deriving(Enum,Show)

data GramExpr inp_type var_type --Grammar Expresson, i.e. the rhs of a production.
  = GramOne --the empty string, i.e. the epsilon in Compiler texts.
  | GramInp inp_type --a terminal, i.e. an inp_type, is a Grammar Expression
  | GramVar var_type --a non-terminal, i.e. a var_type, is a Grammar Expression 
  | (:|)  (GramExpr inp_type var_type) (GramExpr inp_type var_type)

    {- 
      :|  is the choice grammar operator. E.g. input, i, matches
        x | y
      if i either matches x or y.
    -}  
       
  | (:>>) (GramExpr inp_type var_type) (GramExpr inp_type var_type)

    {- 
      :>>  is the concatenation grammar operator. E.g. input, i, matches
        x :>> y
      if i matches x followed by y.
    -}
  deriving(Show)

data GramEquation inp_type var_type
  = (:==) var_type (GramExpr inp_type var_type)
  deriving(Show)

data NullableExpr inp_type var_type
  = NullableNot  --can't derive empty string.
  | NullableYes  --can   derive empty string.
  | NullableVar var_type --unknown whether var_type can derive empty string.
  | NullableChoice (NullableExpr inp_type var_type) (NullableExpr inp_type var_type)
  | NullableCat (NullableExpr inp_type var_type) (NullableExpr inp_type var_type)
  deriving(Show)

gram2null :: GramExpr inp_type var_type -> NullableExpr inp_type var_type
{-
  gram2null GramExpr
  returns a NullableExpr expression which indicates whether the GramExpr
  can derive the empty string.
-}

gram2null GramOne = NullableYes
gram2null (GramInp inp_valu) = NullableNot
gram2null (GramVar var_valu) = NullableVar var_valu
gram2null ( left :|  right ) = NullableChoice (gram2null left) (gram2null right)
gram2null ( left :>> right ) = NullableCat    (gram2null left) (gram2null right)

null_reduce :: NullableExpr inp_type var_type -> NullableExpr inp_type var_type

null_reduce NullableNot = NullableNot
null_reduce NullableYes = NullableYes

null_reduce (NullableChoice NullableYes   nullable_right) = NullableYes
null_reduce (NullableChoice nullable_left NullableYes   ) = NullableYes
--null_reduce (NullableChoice NullableNot   nullable_right) = nullable_right
--null_reduce (NullableChoice nullable_left NullableNot   ) = nullable_left
null_reduce (NullableChoice NullableNot   NullableNot   ) = NullableNot
null_reduce (NullableChoice nullable_left nullable_right) = NullableChoice nullable_left nullable_right

null_reduce (NullableCat    NullableNot   nullable_right) = NullableNot
null_reduce (NullableCat    nullable_left NullableNot   ) = NullableNot
--null_reduce (NullableCat    NullableYes   nullable_right) = nullable_right
--null_reduce (NullableCat    nullable_left NullableYes   ) = nullable_left
null_reduce (NullableCat    nullableYes   NullableYes   ) = NullableYes
null_reduce (NullableCat    nullable_left nullable_right) = NullableCat nullable_left nullable_right

main = do
{ print Ident
; print Expr
; print (GramInp Ident::GramExpr ArithInp ArithVar)
; print (GramVar Expr::GramExpr ArithInp ArithVar)
; print ((GramInp Ident :| GramVar Factor)::GramExpr ArithInp ArithVar)
; print ((GramInp Ident :>>GramVar Factor)::GramExpr ArithInp ArithVar)
; print ((Factor :== GramInp Ident)::GramEquation ArithInp ArithVar)
; print ([ Factor :==
           (   GramInp Ident
           :|  (   GramInp ParenLeft 
               :>> GramVar Expr 
               :>> GramInp ParenRight
               )
           )
         , Term :== 
           (   GramVar Factor
           :>> GramInp Mult
           :>> GramVar Factor
           )
         , Expr :== 
           (   GramVar Term
           :>> GramInp Plus
           :>> GramVar Term
           )
         ]
         ::[GramEquation ArithInp ArithVar])
         {-
           The above arg to print is the arithmetic expression grammar.
         -}

; print ((gram2null (GramInp Mult))::(NullableExpr ArithInp ArithVar))
; print ((gram2null (GramVar Factor))::(NullableExpr ArithInp ArithVar))
; print ((gram2null (GramVar Factor :| GramOne))::(NullableExpr ArithInp ArithVar))
; print (null_reduce ((gram2null (GramVar Factor :|  GramOne))::(NullableExpr ArithInp ArithVar)))
; print (null_reduce ((gram2null (GramVar Factor :>> GramOne))::(NullableExpr ArithInp ArithVar)))
; print (null_reduce ((gram2null (GramInp Ident  :>> GramOne))::(NullableExpr ArithInp ArithVar)))
;}


------------------------------------------------------------------------

{-
Purpose:
  Demonstrate the use of Functor class to define
  a homomorphism between abstract data types.
Motivation:
  In category theory, a Functor is a map from one
  category, Src, to another, Target.  IOW, a Functor maps
  Src.objects to Target.objects and Src.morphisms to Target.morphisms.
  
  Since this description of Function is similar to that of an
  algebraic homomorphism, *maybe* a Functor can be used to define
  the homomorphism.
-}

data Alg0Type
  = Alg0_Op0_0
  | Alg0_Op0_1
  | Alg0_Op1_0 Alg0Type
  | Alg0_Op2_0 Alg0Type Alg0Type
  deriving(Show)

data Alg1Type
  = Alg1_Op0_0
  | Alg1_Op0_1
  | Alg1_Op1_0 Alg1Type
  | Alg1_Op2_0 Alg1Type Alg1Type
  deriving(Show)

alg0_to_alg1 :: Alg0Type -> Alg1Type --homomorphism
alg0_to_alg1 Alg0_Op0_0 = Alg1_Op0_0
alg0_to_alg1 Alg0_Op0_1 = Alg1_Op0_1
alg0_to_alg1 (Alg0_Op1_0 a0) = Alg1_Op1_0 (alg0_to_alg1 a0)
alg0_to_alg1 (Alg0_Op2_0 a0 a1) = Alg1_Op2_0 (alg0_to_alg1 a0) (alg0_to_alg1 a1)

{-
Functor Alg?Type
  fmap alg0_to_alg1 ? 
-}

main = do
{ print Alg0_Op0_0
; print (Alg0_Op1_0 Alg0_Op0_0)
; print (alg0_to_alg1 (Alg0_Op1_0 Alg0_Op0_0))
; print (alg0_to_alg1 (Alg0_Op2_0 Alg0_Op0_0 Alg0_Op0_1))
}