octopus-0.0.1.0: Octopus/Basis.hs

{-| This module contains values that help create and manipulate Octopus
    values that are used by the interpreter, but not strictly primitive,
    that is, they could just as easily be defined in user-space, as long
    as the machine could get at them.
-}
module Octopus.Basis (
      mkVau
    -- * Basic Protocols
    -- ** Combination
    , mkCall
    , callOpr
    , callArg
    , ensureCombination
    -- ** Closure
    , mkClosure
    , ensureClosure
    -- ** Suspension
    , mkThunk
    , ensureThunk

    , module Octopus.Shortcut
    ) where

import Import
import qualified Data.Sequence as Seq
import qualified Data.Map as Map

import Octopus.Data
import Octopus.Shortcut


mkVau :: String -> String -> Val -> Val
mkVau e arg body = mkCall (Pr Vau) (mkSq [mkSq [Sy $ intern e, Sy $ intern arg], body])


{-| Construct a combination: an object with a
    @__car__@ slot and a @__cdr__@ slot.
-}
mkCall :: Val -- ^ Combiner (@__car__@)
           -> Val -- ^ Argument (@__cdr__@)
           -> Val
mkCall f x = mkOb [(callOpr, f), (callArg, x)]

{-| Extract a (combiner, argument) pair from a
    combination-responsive object.
-}
ensureCombination :: Val -> Maybe (Val, Val)
ensureCombination (Ob ob) = (,) <$> Map.lookup callOpr ob
                                <*> Map.lookup callArg ob
ensureCombination _ = Nothing

{-| Combiner slot name in a combination (aka. application) -}
callOpr :: Symbol
callOpr = intern "__car__"
{-| Argument slot name in a combination (aka. application) -}
callArg :: Symbol
callArg = intern "__cdr__"


{-| Construct a closure: an object with @__var__@,
    @__ast__@ and @__env__@ slots.
-}
mkClosure :: Val -- ^ Body (@__ast__@)
          -> Val -- ^ Static environment (@__env__@)
          -> Val -- ^ Parameter (@__arg__@)
          -> Val
mkClosure var ast env = Cl var ast env

{-| Extract a (body, environment, parameter) triple from
    a closure-responsive object.
-}
ensureClosure :: Val -> Maybe (Val, Val, Val)
ensureClosure (Cl var ast env) = Just (var, ast, env)
ensureClosure _ = Nothing


{-| Construct a thunk: a (environment, body) pair. -}
mkThunk :: Val -- ^ Environment (second element)
        -> Val -- ^ Body (first element)
        -> Val
mkThunk env ast = Sq $ Seq.fromList [env, ast]

{-| Extract a (environment, body) pair from a thunk-responsive pair. -}
ensureThunk :: Val -> Maybe (Val, Val)
ensureThunk (Sq xs) = case toList xs of
    [env, ast] -> Just (env, ast)
    _ -> Nothing
ensureThunk _ = Nothing