<commit_before>{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}

module Ivory.Tower.Codegen.System
  ( generatedCodeModules
  ) where

import qualified Data.Map as Map
import Data.String (fromString)

import Ivory.Tower.Types.GeneratedCode
import Ivory.Tower.Types.ThreadCode
import Ivory.Tower.Types.Time
import Ivory.Tower.Codegen.Monitor
import Ivory.Tower.Codegen.Handler

import qualified Ivory.Tower.AST as AST

import Ivory.Language

import qualified Ivory.OS.FreeRTOS.Task as Task

generatedCodeModules :: GeneratedCode -> AST.Tower -> [Module]
generatedCodeModules gc twr
   = generatedcode_modules gc
  ++ map threadUserModule ts
  ++ map threadGenModule ts
  ++ concatMap monitorModules ms
  ++ [ initModule twr ]
  where
  ms = Map.toList (generatedcode_monitors gc)
  ts = Map.elems (generatedcode_threads gc)

  monitorModules (ast, code) = generateMonitorCode code ast

  threadUserModule tc =
    let t = threadcode_thread tc in
    package (threadUserCodeModName t) $ do
      depend (threadGenModule tc)
      threadcode_user tc
  threadGenModule tc =
    let t = threadcode_thread tc in
    package (threadGenCodeModName t) $ do
      depend (threadUserModule tc)
      mapM_ depend (threadGenDeps t)
      threadLoopModdef twr t
      threadcode_gen tc


  threadGenDeps :: AST.Thread -> [Module]
  threadGenDeps t = [ package (monitorGenModName m) (return ())
                    | (m,_h) <- AST.threadHandlers (AST.messageGraph twr) t ]

threadUserCodeModName :: AST.Thread -> String
threadUserCodeModName t = "tower_user_" ++ AST.threadName t

threadGenCodeModName :: AST.Thread -> String
threadGenCodeModName t = "tower_gen_" ++ AST.threadName t

threadLoopProcName :: AST.Thread -> String
threadLoopProcName t = "loop_" ++ AST.threadName t


threadLoopModdef :: AST.Tower -> AST.Thread -> ModuleDef
threadLoopModdef twr thr = do
  Task.moddef
  incl (threadLoopProc twr thr)


threadLoopProc :: AST.Tower -> AST.Thread
               -> Def('[Ref Global (Struct "taskarg")]:->())
threadLoopProc twr thr = proc (threadLoopProcName thr) $ const $ body $ do
  -- XXX guard on init here
  forever $ do
    -- XXX guard on event here
    t <- local (ival 666) -- XXX
    sequence_ [ call_ (hproc h) (constRef t)
              | (_m,h) <- AST.towerChanHandlers twr (AST.threadChan thr) ]

  where
  hproc :: AST.Handler -> Def('[ConstRef s (Stored ITime)]:->())
  hproc h = proc (handlerProcName h thr) (const (body (return ())))

initModule :: AST.Tower -> Module
initModule twr = package "tower_init" $ do
  Task.moddef
  sequence_ [ depend (package (monitorGenModName m) (return ()))
            | m <- AST.tower_monitors twr ]
  sequence_ [ depend (package (threadGenCodeModName t) (return ()))
            | t <- AST.towerThreads twr ]
  incl initProc
  where
  initProc :: Def('[]:->())
  initProc = proc "tower_init" $ body $ do
    sequence_ [ call_ (monitorInitProc m) | m <- AST.tower_monitors twr ]
    sequence_ [ threadBegin twr thr | thr <- AST.towerThreads twr ]

threadBegin :: AST.Tower -> AST.Thread -> Ivory eff ()
threadBegin twr thr = do
  call_ Task.begin (Task.taskProc (threadLoopProc twr thr))
                stacksize priority debugname
  where
  stacksize :: Uint32
  stacksize = 1024 -- XXX need some story for computing this

  priority :: Uint8
  priority = 3 -- XXX should be possible to compute this properly

  debugname :: IString
  debugname = fromString (AST.threadName thr)

<commit_msg>tower - determine freertos priority<commit_after>{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}

module Ivory.Tower.Codegen.System
  ( generatedCodeModules
  ) where

import qualified Data.Map as Map
import Data.String (fromString)
import Data.List (sort, elemIndex)

import Ivory.Tower.Types.GeneratedCode
import Ivory.Tower.Types.ThreadCode
import Ivory.Tower.Types.Time
import Ivory.Tower.Codegen.Monitor
import Ivory.Tower.Codegen.Handler

import qualified Ivory.Tower.AST as AST

import Ivory.Language

import qualified Ivory.OS.FreeRTOS.Task as Task

generatedCodeModules :: GeneratedCode -> AST.Tower -> [Module]
generatedCodeModules gc twr
   = generatedcode_modules gc
  ++ map threadUserModule ts
  ++ map threadGenModule ts
  ++ concatMap monitorModules ms
  ++ [ initModule twr ]
  where
  ms = Map.toList (generatedcode_monitors gc)
  ts = Map.elems (generatedcode_threads gc)

  monitorModules (ast, code) = generateMonitorCode code ast

  threadUserModule tc =
    let t = threadcode_thread tc in
    package (threadUserCodeModName t) $ do
      depend (threadGenModule tc)
      threadcode_user tc
  threadGenModule tc =
    let t = threadcode_thread tc in
    package (threadGenCodeModName t) $ do
      depend (threadUserModule tc)
      mapM_ depend (threadGenDeps t)
      threadLoopModdef twr t
      threadcode_gen tc


  threadGenDeps :: AST.Thread -> [Module]
  threadGenDeps t = [ package (monitorGenModName m) (return ())
                    | (m,_h) <- AST.threadHandlers (AST.messageGraph twr) t ]

threadUserCodeModName :: AST.Thread -> String
threadUserCodeModName t = "tower_user_" ++ AST.threadName t

threadGenCodeModName :: AST.Thread -> String
threadGenCodeModName t = "tower_gen_" ++ AST.threadName t

threadLoopProcName :: AST.Thread -> String
threadLoopProcName t = "loop_" ++ AST.threadName t


threadLoopModdef :: AST.Tower -> AST.Thread -> ModuleDef
threadLoopModdef twr thr = do
  Task.moddef
  incl (threadLoopProc twr thr)


threadLoopProc :: AST.Tower -> AST.Thread
               -> Def('[Ref Global (Struct "taskarg")]:->())
threadLoopProc twr thr = proc (threadLoopProcName thr) $ const $ body $ do
  -- XXX guard on init here
  forever $ do
    -- XXX guard on event here
    t <- local (ival 666) -- XXX
    sequence_ [ call_ (hproc h) (constRef t)
              | (_m,h) <- AST.towerChanHandlers twr (AST.threadChan thr) ]

  where
  hproc :: AST.Handler -> Def('[ConstRef s (Stored ITime)]:->())
  hproc h = proc (handlerProcName h thr) (const (body (return ())))

initModule :: AST.Tower -> Module
initModule twr = package "tower_init" $ do
  Task.moddef
  sequence_ [ depend (package (monitorGenModName m) (return ()))
            | m <- AST.tower_monitors twr ]
  sequence_ [ depend (package (threadGenCodeModName t) (return ()))
            | t <- AST.towerThreads twr ]
  incl initProc
  where
  initProc :: Def('[]:->())
  initProc = proc "tower_init" $ body $ do
    sequence_ [ call_ (monitorInitProc m) | m <- AST.tower_monitors twr ]
    sequence_ [ threadBegin twr thr | thr <- AST.towerThreads twr ]

threadBegin :: AST.Tower -> AST.Thread -> Ivory eff ()
threadBegin twr thr = do
  call_ Task.begin (Task.taskProc (threadLoopProc twr thr))
                stacksize priority debugname
  where
  stacksize :: Uint32
  stacksize = 1024 -- XXX need some story for computing this

  priority :: Uint8
  priority = fromIntegral (threadPriority twr thr)

  debugname :: IString
  debugname = fromString (AST.threadName thr)

threadPriority :: AST.Tower -> AST.Thread -> Int
threadPriority twr thr = idx + 1
  where
  Just idx = elemIndex thr priorityordering
  priorityordering = reverse (sort (AST.towerThreads twr))

{'fraction_non_alphanumeric': 0.10082621481585212, 'fraction_numerical': 0.003080801008262148, 'mean_word_length': 3.4332712600869026, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 39, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '962392', 'n_tokens_mistral': 2360, 'n_tokens_neox': 2275, 'n_words': 668}