# Joy in Haskell

## sz — 2000-08-22 14:49:52

    Hello Concatenative,

    Well, it is. At the end of message is Haskell module for

    Joy-in-Haskell. At least it works with 'putstr' definition I gave to

    it today.

    Inner workings are (non-)trivial. Basically, Joy program written in

    Haskell forms complex computation on Joy state (function which takes

    joy state and produces some meaningful result/output and changed

    state), which includes three stacks (data, auxillary and execution),

    input and output character streams. This is essential characteristic

    of Joy itself as far as I understand it and is well supported by

    Haskell Monads. I am really excited how well they are fit one another.

    What to say? It is easy to add primitives, new types (I already

    extended Joy with Bool type), new definitions... Maybe lambdas, as

    someone dreams about...

    What's next? I don't know. Today I am interesting in proof of finite

    resource usage - both time and space, - for some set of simple

    programs. Is here anybody who thinks about it? (also completely crazy

    idea - interpreter of Haskell in Joy? ;)

    Best regards,

     sz                          mailto:sz@...

    PS

    I tested it with Hugs (win32) from November '99:

    hugs Joy.lhs

    Joy>test

    "test!"

    PPS

    The source.

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

    This is literate Haskell module. Code lines are prefixed with '>'.

     >module Joy(

    >       JCell(..),JStack,JoyP(..),JoyT,JFunc,JoyR,

    >       jinterp,joutput,

    >       -- sugar around definitions

    >       def,ja,jc,ji,jb,js,jf,jl,

    >       -- various primitives

    >       swap,jdrop,jnot,jgetc,jputc,jdrop,nulllist,splitlist,

    >       -- combinators

    >       ifte,

    >       -- things that are definitions

    >       putstr

    >       ) where

     The Joy Cell type. It can be one of many different kinds:

    character, integer, floating point, list, action...

     >data   JCell =

    >         JChar         Char

    >       | JInt          Int

    >       | JBool         Bool

    >       | JFloat        Double

    >       | JList         [JCell]

    >       | JAct          JFunc

    >

     The stack.

     >type   JStack = [JCell]

     Joy program state: data stack, auxillary stack and execution stack.

    String - lazy list of input. Second String - lazy reversed list of

    Joy output.

     >data JoyP = JoyP JStack JStack JStack String String

    >nulljoy = JoyP [] [] [] [] [] -- I need default starting point

     Joy primitive function type. It does nothing but changing

    state. ;)

    It is compatible with JoyR argument.

     >type JoyT a = JoyP -> (a,JoyP)

    >type JFunc = JoyT ()

    >data JoyR a = JoyR (JoyT a)

    >jruncover (JoyR jr) = jr -- uncovers expression jr

    >

     Basically Monad class needs two methods:

            return a; - which covers value a under monad and

             >>= - 'bind', of type (m a->(a->m b)->m b) which takes

                     value of type a covered by monad m, function

                    which takes value of type a and produces

                    covered value b. Result of bind is the value of

                    type b covered under monad.

    Really, Monad of JoyR creates complicated expression (using defs and

    actions) which creates expression of type (JoyP->(a,JoyP)), ie, takes

    an input of Joy program state and produces output of unknown type

    and new Joy program state.

    That's wonderful! I'm glad I can't completely understand how it

    works! ;)

     >instance Monad JoyR where

    >       return a = JoyR (\jt -> (a,jt))

    >       (JoyR jr) >>= f = JoyR (

    >                               \jt -> let (v,jt') = jr jt

    >                                      in (jruncover(f v)) jt'

    >                       )

    >

     Various functions over Joy state. They are used inside JoyR monadic

    computations so they're packed in JoyR.

     >push   x       = JoyR( \(JoyP ds as es i o)    -> ((),JoyP (x:ds) as es i o))

    >pop            = JoyR( \(JoyP (h:ds) as es i o)-> (h, JoyP ds as es i o))

    >apush  x       = JoyR( \(JoyP ds as es i o)    -> ((),JoyP ds (x:as) es i o))

    >apop           = JoyR( \(JoyP ds (h:as) es i o)-> (h, JoyP ds as es i o))

    >epush  x       = JoyR( \(JoyP ds as es i o)    -> ((),JoyP ds as (x:es) i o))

    >epop           = JoyR( \(JoyP ds as (h:es) i o)-> (h, JoyP ds as es i o))

    >e_nonempty     = JoyR( \jp@(JoyP ds as es i o) -> (nonempty es,jp))

    >

    >-- I didn't find that in Prelude.

    >nonempty [] = False

    >nonempty _ = True

    >empty l = not (nonempty l)

    >

    >-- this is used later

    >jputc' c       = JoyR( \(JoyP ds as es i o)-> ((), JoyP ds as es i (c:o)))

    >jgetc'         = JoyR( \(JoyP ds as es (c:i) o)-> (c, JoyP ds as es i o))

    >jhasinp'       = JoyR( \(JoyP ds as es i o)-> (nonempty i, JoyP ds as es i o))

    >

    >jexec (JAct f) = JoyR f -- if it is action, then perform it

    >jexec x        = push x -- if it is literal - push it.

    >-- guard

    >jinterp' = do

    >       ene <- e_nonempty

    >       (if ene then jinterp'' else return ())

    >

    >-- unguarded portion of jinterp'

    >jinterp'' = do

    >       e <- epop

    >       case e of

    >               JList [] -> jinterp'    -- we should return

    >               JList (e:es) -> do      -- has something to do

    >                       epush (JList es) -- return rest to stack

    >                       jexec e -- execute

    >                       jinterp' -- continue main loop

    >

    >jinterp joy def = -- execute def in joy environment

    >       let resjoy = (\(x,y) -> y) ((jruncover (interpret def)) joy)

    >       in resjoy

    >       where

    >               interpret def = do

    >                       jexec def

    >                       jinterp'

    >

    >joutput joy def = -- execute def on joy environment and return output produced.

    >       (\(JoyP ds as es i o) -> reverse o) (jinterp joy def)

     How we handle definitions. 'ja' is shorthand which repacks monadic

    actions into Joy actions.

     >def list = ja (do { epush (JList list);})

    >ja (JoyR f) = JAct f

    >jf x = JFloat x

    >ji  i = JInt i

    >jc  c = JChar c

    >jb  b = JBool b

    >js str = JList (tolist str) where

    >               tolist [] = []

    >               tolist (c:cs) = (JChar c):tolist cs

    >jl list = JList list

     Some primitives. The most complicated one is the ifte:

    pop <else> quotation, pop <then> quotation, pop condition.

    if condition dequote <then> quotation, else dequote <else>.

     >jgetc = ja (do {c<-jgetc'; push (JChar c);})

    >jputc = ja (do { (JChar c)<-pop; jputc' c;})

    >jdrop = ja (do { dropped<-pop; return ();}) -- "return ();" needed by typechecker

    >jnot =  ja (do { (JBool cond)<-pop; push (JBool (not cond));})

    >ifte = ja (do { lelse<-pop; lthen<-pop; (JBool cond)<-pop; (if cond then epush lthen else epush lelse)})

    >nulllist = ja (do { (JList l)<-pop; push (JList l); push (JBool (empty l))})

    >splitlist = ja (do { (JList (h:t))<-pop; push (JList t); push h})

    >swap = ja (do { x <- pop; y <- pop; push y; push x})

    >

     Testing how the thing works.

     >putstr = def [ nulllist, jnot, jl [ splitlist, jputc, putstr], jl [ jdrop ], ifte]

    >testdef = def [ js "test", putstr, jc '!', jputc ]

    >test = joutput nulljoy testdef -- outputs "test!"

    >

     Rules are:

     - if you define a Joy definition 'name = def ...' then you

       may use 'name' inside a list unprefixed.

     - 'jl' is a prefix for a list (quotation), 'ja' (used rarely) -

       for Joy actions (primitives), 'js' - for string literals,

       'jc' - for characters, 'jb', 'ji' and 'jf' - for Booleans,

       Integers and Floats respectively.

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