diff --git a/shoresh-engine/shoresh-engine.cabal b/shoresh-engine/shoresh-engine.cabal index d270bda7..ca006695 100644 --- a/shoresh-engine/shoresh-engine.cabal +++ b/shoresh-engine/shoresh-engine.cabal @@ -28,6 +28,7 @@ library Shoresh.KetivQere Shoresh.Smikhut Shoresh.Lexicon + Shoresh.Roots Shoresh.Graph Shoresh.Havdalah Shoresh.Kriah diff --git a/shoresh-engine/src/Shoresh/Roots.hs b/shoresh-engine/src/Shoresh/Roots.hs new file mode 100644 index 00000000..24040abc --- /dev/null +++ b/shoresh-engine/src/Shoresh/Roots.hs @@ -0,0 +1,274 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Roots — hearing the shoresh of a word from L1. +-- +-- Broken tablet 33 (2026-10-04). Until now the server's @extractRoots@ +-- called every word of two or three letters a root and dropped every +-- longer word: את became א-ת-ה (padded with a He the text never wrote), +-- ואת became ו-א-ת, בכל became ב-כ-ל, and ויאמר, ואהבת, אלהים produced +-- nothing at all. Handed the whole of Devarim 6:5 it found no א-ה-ב. +-- It never opened L1. +-- +-- "The lexicon is read from L1. It is not hardcoded. The system reads +-- Torah and learns what roots are there." (Shoresh.Lexicon) — so this +-- module does that. A word's root is what L1 records for that word: +-- +-- 1. 'FromVerse' — the word stands in the verse in scope; L1's +-- @shoresh@ for that very word (and its binyan, if it +-- is a verb, from the morphology). +-- 2. 'FromLemma' — the word stands in L1 without a @shoresh@ of its +-- own (לבבך, נפשך), but shares its lemma with words +-- that have one (לבב, נפש). +-- 3. 'FromTorah' — the word is not in the verse in scope but appears +-- elsewhere in Torah; the root it most often carries. +-- 4. 'NamedRoot' — the asker wrote a root itself (ברא) and Torah +-- knows it as a root. +-- +-- A word L1 does not know yields nothing. A particle L1 gives no root +-- (את) yields nothing. The engine does not invent a root to have +-- something to say. +-- +-- What this does NOT repair: the quality of L1's own @shoresh@ field, +-- which is derived (ויהי is recorded as יהי, שמים as שמ). That is the +-- quarry's tablet, not the mason's; this module is faithful to L1. +module Shoresh.Roots + ( RootIndex + , emptyIndex + , indexVerse + , buildIndex + , loadIndex + , indexStats + , Derivation(..) + , ResolvedRoot(..) + , resolveText + , tokenize + , binyanFromMorph + ) where + +import Control.Exception (SomeException, try) +import Control.Monad (foldM, guard) +import Data.Char (isDigit) +import Data.List (foldl', sort, sortOn) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (listToMaybe, mapMaybe) +import Data.Ord (Down(..)) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import System.Directory (doesDirectoryExist, listDirectory) +import System.FilePath ((), takeExtension) +import Text.Read (readMaybe) + +import Shoresh.Lexicon (L1Verse(..), L1Word(..), loadL1Verse) +import Shoresh.Types (Binyan(..)) + + +-- | What L1 teaches about its words, gathered once. +data RootIndex = RootIndex + { riSurface :: !(Map (Text, Text) (Map Text Int)) + -- ^ (consonants, lemma) → shoresh → count + , riSurfaceLemma :: !(Map Text (Map Text Int)) -- ^ consonants → lemma → count + , riLemma :: !(Map Text (Map Text Int)) -- ^ lemma → shoresh → count + , riRoots :: !(Set Text) -- ^ every shoresh L1 records + , riVerses :: !Int + } + +emptyIndex :: RootIndex +emptyIndex = RootIndex Map.empty Map.empty Map.empty Set.empty 0 + +-- | (verses, distinct surface forms, distinct roots) +indexStats :: RootIndex -> (Int, Int, Int) +indexStats ix = (riVerses ix, Map.size (riSurfaceLemma ix), Set.size (riRoots ix)) + +bump :: Ord k => k -> Text -> Map k (Map Text Int) -> Map k (Map Text Int) +bump k v = Map.insertWith (Map.unionWith (+)) k (Map.singleton v 1) + +-- | Add one verse's words to the index. +indexVerse :: RootIndex -> L1Verse -> RootIndex +indexVerse ix verse = + let ix' = foldl' addWord ix (l1vWords verse) + in ix' { riVerses = riVerses ix' + 1 } + where + addWord acc w = + let lemma = l1wLemma w + surfaces = splitMaqaf (l1wConsonants w) + withLemma a s = a { riSurfaceLemma = bump s lemma (riSurfaceLemma a) } + acc1 = foldl' withLemma acc surfaces + in case l1wShoresh w of + Nothing -> acc1 + Just sh | T.null sh -> acc1 + | otherwise -> + let withSurface a s = a { riSurface = bump (s, lemma) sh (riSurface a) } + acc2 = foldl' withSurface acc1 surfaces + in acc2 { riLemma = if realLemma lemma + then bump lemma sh (riLemma acc2) + else riLemma acc2 + , riRoots = Set.insert sh (riRoots acc2) + } + +buildIndex :: [L1Verse] -> RootIndex +buildIndex = foldl' indexVerse emptyIndex + +-- | A lemma that names a lexeme (a Strong's number), as opposed to the +-- bare prefix letters L1 records for pronominal forms (@l@, @b@). +realLemma :: Text -> Bool +realLemma l = case T.uncons l of + Just (c, _) -> isDigit c + Nothing -> False + +-- | Read every verse under @/torah@ into an index. A missing or +-- unreadable L1 gives an empty index: the engine then finds no roots and +-- says so, rather than guessing. +loadIndex :: FilePath -> IO RootIndex +loadIndex l1root = do + let torah = l1root "torah" + ok <- doesDirectoryExist torah + if not ok then return emptyIndex else do + books <- sort <$> listDirectory torah + foldM (loadBook torah) emptyIndex books + where + loadBook torah ix book = do + let bdir = torah book + isDir <- doesDirectoryExist bdir + if not isDir then return ix else do + chapters <- numbered <$> listDirectory bdir + foldM (loadChapter bdir) ix chapters + + loadChapter bdir ix ch = do + let cdir = bdir show ch + isDir <- doesDirectoryExist cdir + if not isDir then return ix else do + files <- listDirectory cdir + let verses = sort (mapMaybe verseNumber files) + foldM (loadVerse cdir) ix verses + + loadVerse cdir ix v = do + r <- try (loadL1Verse (cdir (show v ++ ".json"))) + :: IO (Either SomeException (Maybe L1Verse)) + return $! case r of + Right (Just verse) -> indexVerse ix verse + _ -> ix + + numbered :: [FilePath] -> [Int] + numbered = sort . mapMaybe readMaybe + + verseNumber :: FilePath -> Maybe Int + verseNumber f + | takeExtension f == ".json" = readMaybe (takeWhile (/= '.') f) + | otherwise = Nothing + + +-- | How a root was heard. +data Derivation = FromVerse | FromLemma | FromTorah | NamedRoot + deriving (Eq, Show) + +data ResolvedRoot = ResolvedRoot + { rrShoresh :: !Text -- ^ exactly as L1 records it (2 or 3 letters) + , rrSurface :: !Text -- ^ the word it was heard from + , rrBinyan :: !(Maybe Binyan) -- ^ only for a verb standing in the scoped verse + , rrDerivation :: !Derivation + } deriving (Eq, Show) + + +-- | The Hebrew words of a text as bare consonants, in order. +-- Maqaf is split BEFORE the marks are stripped: it sits inside the +-- combining-mark range and would otherwise fuse two words (tablet 30a). +tokenize :: Text -> [Text] +tokenize = + filter (not . T.null) + . T.split (not . isHebrewLetter) + . T.filter (not . isMark) + . T.map (\c -> if c == '\x05BE' then ' ' else c) + where + isMark c = c >= '\x0591' && c <= '\x05C7' + +isHebrewLetter :: Char -> Bool +isHebrewLetter c = c >= '\x05D0' && c <= '\x05EA' + +splitMaqaf :: Text -> [Text] +splitMaqaf = filter (not . T.null) . T.splitOn "\x05BE" + + +-- | Resolve every Hebrew word of a text to its root, in order, each root +-- once. The verse in scope, when there is one, is consulted first. +resolveText :: RootIndex -> Maybe L1Verse -> Text -> [ResolvedRoot] +resolveText ix mverse = + dedupe . mapMaybe (resolveWord ix mverse) . tokenize + where + dedupe = go Set.empty + go _ [] = [] + go seen (r:rs) + | rrShoresh r `Set.member` seen = go seen rs + | otherwise = r : go (Set.insert (rrShoresh r) seen) rs + +resolveWord :: RootIndex -> Maybe L1Verse -> Text -> Maybe ResolvedRoot +resolveWord ix mverse w = case here of + (_:_) -> inVerse + [] -> case Map.lookup w (riSurfaceLemma ix) of + Just lemmas -> inTorah lemmas + Nothing -> named + where + verseWords = maybe [] l1vWords mverse + here = filter (\lw -> w `elem` splitMaqaf (l1wConsonants lw)) verseWords + + -- The word stands in the verse in scope. What L1 says of it THERE is + -- the whole answer: its own shoresh, else its lemma's; and if L1 gives + -- it neither (את, אל, אשר), it has no root here — whatever a homograph + -- elsewhere in Torah may carry. + inVerse = firstJust + [ listToMaybe + [ ResolvedRoot sh w (binyanFromMorph (l1wMorph lw)) FromVerse + | lw <- here, Just sh <- [l1wShoresh lw], not (T.null sh) ] + , firstJust [ viaLemma (l1wLemma lw) | lw <- here ] + ] + + -- The word is not in the verse in scope but Torah has it. Read it + -- the way Torah most often does: its most common lemma decides. + -- אשר is the relative particle 1649 times and a name 14 times; the + -- particle wins, and a particle has no root. + inTorah lemmas = do + lemma <- mostCommon lemmas + firstJust + [ do sh <- mostCommon =<< Map.lookup (w, lemma) (riSurface ix) + return (ResolvedRoot sh w Nothing FromTorah) + , viaLemma lemma + ] + + -- No shoresh of its own, but a lemma whose other words have one. + viaLemma lemma = do + guard (realLemma lemma) + sh <- mostCommon =<< Map.lookup lemma (riLemma ix) + return (ResolvedRoot sh w Nothing FromLemma) + + -- Torah has no such word, but knows it as a root: the asker named one. + named + | w `Set.member` riRoots ix = Just (ResolvedRoot w w Nothing NamedRoot) + | otherwise = Nothing + +firstJust :: [Maybe a] -> Maybe a +firstJust = listToMaybe . mapMaybe id + +-- | The key with the highest count; ties go to the lesser key, so the +-- answer does not depend on map traversal accidents. +mostCommon :: Map Text Int -> Maybe Text +mostCommon m = fmap fst . listToMaybe $ sortOn (\(k, n) -> (Down n, k)) (Map.toList m) + + +-- | The binyan a verb stands in, from its OSHB morphology code +-- (e.g. @HC/Vqw3ms@ → Qal, @HVhp1cs@ → Hifil). 'Nothing' for a word +-- that is not a verb, or a stem outside the seven. +binyanFromMorph :: Text -> Maybe Binyan +binyanFromMorph morph = + listToMaybe (mapMaybe stem (T.splitOn "/" (T.dropWhile (== 'H') morph))) + where + stem seg = case T.unpack (T.take 2 seg) of + ['V', 'q'] -> Just Qal + ['V', 'N'] -> Just Nifal + ['V', 'p'] -> Just Piel + ['V', 'P'] -> Just Pual + ['V', 'h'] -> Just Hifil + ['V', 'H'] -> Just Hofal + ['V', 't'] -> Just Hitpael + _ -> Nothing diff --git a/shoresh-engine/src/Shoresh/Server.hs b/shoresh-engine/src/Shoresh/Server.hs index 7930c8de..55637078 100644 --- a/shoresh-engine/src/Shoresh/Server.hs +++ b/shoresh-engine/src/Shoresh/Server.hs @@ -16,6 +16,8 @@ module Shoresh.Server ( runServer , handleRequest + , Env(..) + , loadEnv ) where import qualified Data.ByteString.Char8 as BS8 @@ -29,13 +31,15 @@ import Data.Maybe (mapMaybe) import System.IO (hSetBuffering, stdin, stdout, stderr, BufferMode(..), hFlush, hIsEOF) import System.Directory (doesFileExist) +import System.Environment (lookupEnv) +import System.FilePath (()) import Control.Exception (catch, SomeException) import Shoresh.Types import Shoresh.Gematria -import Shoresh.Binyanim import Shoresh.Teamim import Shoresh.Lexicon +import Shoresh.Roots -- | Run the JSON-line server loop. @@ -48,37 +52,59 @@ runServer = do hSetBuffering stdin LineBuffering hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering - serverLoop + env <- loadEnv + serverLoop env + + +-- | What the server holds for its whole life: where L1 is, and what L1 +-- teaches about its words. +data Env = Env + { envL1Root :: FilePath + , envRoots :: RootIndex + } + +-- | Find L1 and read it once. The pipeline sets @L1_MOUNT_POINT@ +-- (/mnt/torah on the pod); a bare checkout has @l1/@ beside it. Until +-- tablet 33 the path was the literal @l1/torah/…@ relative to the +-- working directory, which on the pod is not where the scroll is — so +-- @parse_tree@ was null there and nobody had noticed. +loadEnv :: IO Env +loadEnv = do + l1root <- maybe "l1" id <$> lookupEnv "L1_MOUNT_POINT" + ix <- loadIndex l1root + -- Force the index before the first request is read. + let (nVerses, nSurfaces, nRoots) = indexStats ix + nVerses `seq` nSurfaces `seq` nRoots `seq` return (Env l1root ix) -- | Main server loop: read line, process, write line, repeat. -serverLoop :: IO () -serverLoop = do +serverLoop :: Env -> IO () +serverLoop env = do eof <- hIsEOF stdin if eof then return () else do line <- BL.fromStrict <$> BS8.getLine - response <- processLine line + response <- processLine env line BLC.putStrLn (encode response) hFlush stdout - serverLoop + serverLoop env -- | Process a single JSON line and return a response. -processLine :: BL.ByteString -> IO Value -processLine line = case eitherDecode line of +processLine :: Env -> BL.ByteString -> IO Value +processLine env line = case eitherDecode line of Left err -> return $ errorResponse "PARSE_ERROR" (T.pack err) - Right req -> handleRequest req + Right req -> handleRequest env req `catch` \e -> return $ errorResponse "INTERNAL_ERROR" (T.pack $ show (e :: SomeException)) -- | Handle a parsed request and produce a response. -handleRequest :: Value -> IO Value -handleRequest val = case parseOperation val of +handleRequest :: Env -> Value -> IO Value +handleRequest env val = case parseOperation val of Nothing -> return $ errorResponse "INVALID_OPERATION" "Missing or invalid 'operation' field" - Just "process" -> handleProcess val + Just "process" -> handleProcess env val Just "separate" -> handleSeparate val Just "name" -> handleName val Just "evaluate" -> handleEvaluate val @@ -103,36 +129,29 @@ parseOperation _ = Nothing -- | Handle "process" operation — root activation, te'amim parse, gematria. -- Construction spec §3.1: Takes text + scope, returns roots_activated, -- parse_tree, dual_readings. -handleProcess :: Value -> IO Value -handleProcess val = do +handleProcess :: Env -> Value -> IO Value +handleProcess env val = do let reqText = extractText val mscope = extractScope val - -- Parse roots from input text - let roots = extractRoots reqText - - -- Build activated roots with gematria and binyanim - let activatedRoots = map activateRoot roots - - -- If scope is provided, load verse from L1 and parse te'amim - (parseTree, dualReadings) <- case mscope of - Nothing -> return (Null, toJSON ([] :: [Value])) + -- The verse in scope, if one was named and L1 has it. + mverse <- case mscope of + Nothing -> return Nothing Just (book, ch, vs) -> do - let path = "l1/torah/" ++ T.unpack (bookToText book) - ++ "/" ++ show ch ++ "/" ++ show vs ++ ".json" + let path = envL1Root env "torah" T.unpack (bookToText book) + show ch (show vs ++ ".json") exists <- doesFileExist path - if not exists - then return (Null, toJSON ([] :: [Value])) - else do - mverse <- loadL1Verse path - case mverse of - Nothing -> return (Null, toJSON ([] :: [Value])) - Just verse -> do - let annotated = mapMaybe annotateL1Word (l1vWords verse) - tree = readTeamim annotated - ptJson = treeToJson tree - drJson = toJSON ([] :: [Value]) -- Phase 3: extract ketiv/qere - return (ptJson, drJson) + if exists then loadL1Verse path else return Nothing + + -- Each Hebrew word of the input, heard through L1 (Shoresh.Roots). + let activatedRoots = map activateRoot (resolveText (envRoots env) mverse reqText) + + let (parseTree, dualReadings) = case mverse of + Nothing -> (Null, toJSON ([] :: [Value])) + Just verse -> + let annotated = mapMaybe annotateL1Word (l1vWords verse) + -- Phase 3: extract ketiv/qere + in (treeToJson (readTeamim annotated), toJSON ([] :: [Value])) return $ object [ "status" .= ("ok" :: Text) @@ -226,41 +245,40 @@ extractScope (Object obj) = do extractScope _ = Nothing --- | Extract Hebrew roots from input text. -extractRoots :: Text -> [Shoresh] -extractRoots t = - let words' = T.words t - -- Try each word as a potential root - candidates = mapMaybe textToShoresh words' - -- Also try the whole text as a single root - wholeRoot = textToShoresh (T.filter (\c -> c >= '\x05D0' && c <= '\x05EA') t) - in case candidates of - [] -> case wholeRoot of - Just r -> [r] - Nothing -> [] - rs -> rs - - --- | Activate a root: expand through binyanim, compute gematria, find neighbors. -activateRoot :: Shoresh -> Value -activateRoot sh = - let expanded = expand sh - gv = gematriaRoot sh - consonantNames = map consonantName [c1 sh, c2 sh, c3 sh] - defaultBinyan = case Map.lookup Qal expanded of - Just p -> T.pack (show (Shoresh.Types.binyan p)) - Nothing -> "Qal" +-- | Render a root heard from L1 in the port's contract shape +-- (Construction spec §3.1), plus where it was heard from. +-- +-- The shoresh is rendered exactly as L1 records it. A two-letter root +-- (כל, שמ) stays two letters: the old path padded it with He to fit the +-- triliteral type and reported a root — and a gematria — the text does +-- not contain. +-- +-- @binyan@ is the stem the verb actually stands in, read from the +-- verse's morphology. It is null for a noun and for a word that is not +-- in the verse in scope: the old path answered "Qal" for everything. +activateRoot :: ResolvedRoot -> Value +activateRoot r = + let sh = rrShoresh r in object - [ "shoresh" .= consonantNames - , "shoresh_hebrew" .= shoreshToText sh - , "binyan" .= defaultBinyan + [ "shoresh" .= mapMaybe (fmap consonantName . charToConsonant) (T.unpack sh) + , "shoresh_hebrew" .= sh + , "binyan" .= fmap (T.pack . show) (rrBinyan r) , "domain" .= ("unknown" :: Text) -- Phase 3: domain lookup , "torah_refs" .= ([] :: [Value]) -- Phase 3: lexicon lookup - , "gematria_value" .= gv + , "gematria_value" .= gematriaWord sh , "gematria_neighbors" .= ([] :: [Value]) -- Phase 3: lexicon needed , "neighbors" .= ([] :: [Value]) -- Phase 3: lexicon needed + , "surface" .= rrSurface r + , "derivation" .= derivationName (rrDerivation r) ] +derivationName :: Derivation -> Text +derivationName d = case d of + FromVerse -> "verse" + FromLemma -> "lemma" + FromTorah -> "torah" + NamedRoot -> "named_root" + -- | Convert an L1 word to an AnnotatedWord for te'amim parsing. annotateL1Word :: L1Word -> Maybe AnnotatedWord diff --git a/shoresh-engine/test/Spec.hs b/shoresh-engine/test/Spec.hs index 5b2fe98e..f470cb04 100644 --- a/shoresh-engine/test/Spec.hs +++ b/shoresh-engine/test/Spec.hs @@ -22,6 +22,7 @@ import Shoresh.Teamim import Shoresh.KetivQere import Shoresh.Lexicon import Shoresh.Graph +import Shoresh.Roots import Shoresh.KiTov import Luchot.Firmware @@ -36,6 +37,7 @@ main = hspec $ do graphSpec kiTovSpec firmwareSpec + rootsSpec consonantSpec :: Spec consonantSpec = describe "Consonant" $ do @@ -294,6 +296,166 @@ firmwareSpec = describe "Firmware" $ do dibrot `shouldBe` Dibrot () () () () () () () () () () +-- ============================================================ +-- Roots — tablet 33: a word's root is what L1 records for it +-- ============================================================ + +-- | An L1 word as build_l1.py writes it (position, text and te'amim are +-- irrelevant to root resolution). +l1w :: Text -> Text -> Text -> Maybe Text -> L1Word +l1w cons lemma morph sh = L1Word + { l1wPosition = 0, l1wText = cons, l1wConsonants = cons, l1wLemma = lemma + , l1wMorph = morph, l1wTeamim = [], l1wPrefix = Nothing, l1wShoresh = sh } + +l1v :: Text -> Int -> Int -> [L1Word] -> L1Verse +l1v book ch vs ws = L1Verse + { l1vRef = "", l1vBook = book, l1vChapter = ch, l1vVerse = vs + , l1vTextHebrew = "", l1vWords = ws } + +-- Devarim 6:5, as L1 holds it: three suffixed nouns carry no shoresh. +devarim65 :: L1Verse +devarim65 = l1v "devarim" 6 5 + [ l1w "ואהבת" "157" "HC/Vqq2ms" (Just "אהב") + , l1w "את" "853" "HTo" Nothing + , l1w "יהוה" "3068" "HNp" (Just "יהו") + , l1w "אלהיך" "430" "HNcmpc/Sp2ms" Nothing + , l1w "בכל" "3605" "HR/Ncmsc" (Just "כל") + , l1w "לבבך" "3824" "HNcmsc/Sp2ms" Nothing + , l1w "ובכל" "3605" "HC/R/Ncmsc" (Just "כל") + , l1w "נפשך" "5315" "HNcbsc/Sp2ms" Nothing + ] + +-- Elsewhere in Torah: the same lemmas with a shoresh of their own. +elsewhere :: [L1Verse] +elsewhere = + [ l1v "bereishit" 1 1 + [ l1w "בראשית" "7225" "HR/Ncfsa" (Just "ראש") + , l1w "ברא" "1254" "HVqp3ms" (Just "ברא") + , l1w "אלהים" "430" "HNcmpa" (Just "אלה") + , l1w "את" "853" "HTo" Nothing + ] + , l1v "bereishit" 1 3 + [ l1w "ויאמר" "559" "HC/Vqw3ms" (Just "אמר") + , l1w "אור" "216" "HNcbsa" (Just "אור") + , l1w "ויהי־אור" "1961" "HC/Vqw3ms" (Just "יהי") + ] + , l1v "bereishit" 1 4 + [ l1w "ויבדל" "914" "HC/Vhw3ms" (Just "בדל") ] + , l1v "devarim" 4 29 + [ l1w "לבב" "3824" "HNcmsa" (Just "לבב") + , l1w "נפש" "5315" "HNcbsa" (Just "נפש") + ] + -- Homographs. אשר: the relative particle twice, the name Asher once. + -- את: the object marker everywhere, but אתה yields the root את. + , l1v "shemot" 3 14 + [ l1w "אשר" "834 a" "HTr" Nothing + , l1w "אהיה" "1961" "HVqi1cs" (Just "היה") + , l1w "אשר" "834 a" "HTr" Nothing + ] + , l1v "bereishit" 30 13 + [ l1w "אשר" "836" "HNp" (Just "אשר") + , l1w "אתה" "859 a" "HPp2ms" (Just "את") + ] + ] + +testIndex :: RootIndex +testIndex = buildIndex (devarim65 : elsewhere) + +shoreshim :: [ResolvedRoot] -> [Text] +shoreshim = map rrShoresh + +rootsSpec :: Spec +rootsSpec = describe "Roots (tablet 33)" $ do + describe "what the old engine did, and must not do again" $ do + it "a particle is not a root — את yields nothing, never א-ת-ה" $ + resolveText testIndex Nothing "את" `shouldBe` [] + + it "a three-letter word is not a root because it has three letters" $ + -- בכל was reported as ב-כ-ל; L1 says its root is כל. + shoreshim (resolveText testIndex (Just devarim65) "בכל") `shouldBe` ["כל"] + + it "a long word is not dropped — ויאמר is א-מ-ר" $ + shoreshim (resolveText testIndex Nothing "ויאמר") `shouldBe` ["אמר"] + + it "a word Torah does not contain yields nothing" $ + resolveText testIndex Nothing "מחשב" `shouldBe` [] + + it "non-Hebrew input yields nothing" $ + resolveText testIndex Nothing "Test query 1" `shouldBe` [] + + describe "the whole of Devarim 6:5" $ do + let roots = resolveText testIndex (Just devarim65) + "ואהבת את יהוה אלהיך בכל לבבך ובכל נפשך" + + it "finds א-ה-ב, and the heart and the soul" $ + shoreshim roots `shouldBe` ["אהב", "יהו", "אלה", "כל", "לבב", "נפש"] + + it "a word in the verse with its own shoresh is heard from the verse" $ + map rrDerivation (take 2 roots) `shouldBe` [FromVerse, FromVerse] + + it "a suffixed noun with no shoresh is heard through its lemma" $ + [ rrDerivation r | r <- roots, rrShoresh r `elem` ["לבב", "נפש", "אלה"] ] + `shouldBe` [FromLemma, FromLemma, FromLemma] + + it "כל appears once though the verse says it twice" $ + length (filter (== "כל") (shoreshim roots)) `shouldBe` 1 + + describe "binyan" $ do + it "is read from the verb's morphology in the verse" $ do + let v = elsewhere !! 2 + map rrBinyan (resolveText testIndex (Just v) "ויבדל") `shouldBe` [Just Hifil] + map rrBinyan (resolveText testIndex (Just devarim65) "ואהבת") `shouldBe` [Just Qal] + + it "is not claimed for a noun" $ + map rrBinyan (resolveText testIndex (Just devarim65) "בכל") `shouldBe` [Nothing] + + it "is not claimed for a word outside the verse in scope" $ + map rrBinyan (resolveText testIndex (Just devarim65) "ויבדל") `shouldBe` [Nothing] + + it "parses OSHB stems" $ do + binyanFromMorph "HC/Vqw3ms" `shouldBe` Just Qal + binyanFromMorph "HVhp1cs" `shouldBe` Just Hifil + binyanFromMorph "HVNp3ms" `shouldBe` Just Nifal + binyanFromMorph "HVtw3ms" `shouldBe` Just Hitpael + binyanFromMorph "HNcmsa" `shouldBe` Nothing + + describe "homographs" $ do + it "a particle in the verse has no root, though Torah knows את as a root" $ do + resolveText testIndex (Just devarim65) "את" `shouldBe` [] + resolveText testIndex Nothing "את" `shouldBe` [] + + it "out of scope, a word is read the way Torah most often reads it" $ + -- אשר: particle ×2, the name ×1. The particle wins; no root. + resolveText testIndex Nothing "אשר" `shouldBe` [] + + it "in scope, the verse decides — אשר the particle in Shemot 3:14" $ + shoreshim (resolveText testIndex (Just (elsewhere !! 4)) "אהיה אשר אהיה") + `shouldBe` ["היה"] + + describe "other ways a root is heard" $ do + it "from elsewhere in Torah when the word is not in the verse in scope" $ + map (\r -> (rrShoresh r, rrDerivation r)) + (resolveText testIndex (Just devarim65) "ויאמר") + `shouldBe` [("אמר", FromTorah)] + + it "a root the asker names, if Torah knows it as a root" $ + map (\r -> (rrShoresh r, rrDerivation r)) (resolveText testIndex Nothing "אמר") + `shouldBe` [("אמר", NamedRoot)] + + it "a three-letter string Torah does not know as a root is not one" $ + resolveText testIndex Nothing "קטל" `shouldBe` [] + + describe "tokenize" $ do + it "strips nikud and te'amim" $ + tokenize "וַיֹּ֥אמֶר אֱלֹהִ֖ים" `shouldBe` ["ויאמר", "אלהים"] + + it "splits maqaf before stripping marks (tablet 30a)" $ + tokenize "וַֽיְהִי־אֽוֹר ׃" `shouldBe` ["ויהי", "אור"] + + it "indexes both halves of a maqaf-joined L1 word" $ + shoreshim (resolveText testIndex Nothing "ויהי") `shouldBe` ["יהי"] + + -- ============================================================ -- Helpers -- ============================================================ diff --git a/vav_pipeline/lib/vav_pipeline/bereishit_cycle.ex b/vav_pipeline/lib/vav_pipeline/bereishit_cycle.ex index 8be19eab..51ae2f1f 100644 --- a/vav_pipeline/lib/vav_pipeline/bereishit_cycle.ex +++ b/vav_pipeline/lib/vav_pipeline/bereishit_cycle.ex @@ -365,7 +365,13 @@ defmodule VavPipeline.BereishitCycle do ps -> "word " <> Enum.join(Enum.map(ps, &to_string/1), ", ") end - "#{hyphenate(r.shoresh)} (gematria #{r.gematria}, #{r.binyan || "binyan unknown"}, #{where})" + # A binyan is said only where the engine read one off a verb in + # this verse. A noun has none; saying "unknown" (or, before + # tablet 33, "Qal" for everything) claims a question that does + # not exist. + binyan = if r.binyan, do: "#{r.binyan}, ", else: "" + + "#{hyphenate(r.shoresh)} (gematria #{r.gematria}, #{binyan}#{where})" end) group_line = @@ -891,10 +897,20 @@ defmodule VavPipeline.BereishitCycle do Map.get(root, "shoresh_hebrew") || letters_to_hebrew(Map.get(root, "shoresh")) + # Where the root stands in the verse: every word L1 gives this + # shoresh, and — for a root the engine heard through a word's lemma + # (לבבך → לבב; L1 records no shoresh on the suffixed noun itself) — + # the word it was heard from (tablet 33). positions = case shoresh do - nil -> [] - s -> verse_positions_for(s, context) + nil -> + [] + + s -> + (verse_positions_for(s, context) ++ + surface_positions_for(Map.get(root, "surface"), context)) + |> Enum.uniq() + |> Enum.sort() end given_position = Map.get(root, :position) @@ -906,7 +922,8 @@ defmodule VavPipeline.BereishitCycle do binyan: Map.get(root, :binyan) || Map.get(root, "binyan"), domain: Map.get(root, :domain) || Map.get(root, "domain"), torah_refs: Map.get(root, :torah_refs) || Map.get(root, "torah_refs") || [], - word: Map.get(root, :word), + word: Map.get(root, :word) || Map.get(root, "surface"), + derivation: Map.get(root, "derivation"), morph: Map.get(root, :morph), positions: positions, position: given_position || List.first(positions), @@ -924,6 +941,14 @@ defmodule VavPipeline.BereishitCycle do |> Enum.sort() end + defp surface_positions_for(nil, _context), do: [] + + defp surface_positions_for(surface, context) do + (get_in(context, [:verse, :words]) || []) + |> Enum.filter(fn w -> w.consonants == surface end) + |> Enum.map(& &1.position) + end + # The engine's "shoresh" is a list of consonant NAMES ("bet","resh", # "aleph"). shoresh_hebrew is the authoritative Hebrew form and is # always present in practice; this is a last resort that never diff --git a/vav_pipeline/test/liveness_test.exs b/vav_pipeline/test/liveness_test.exs index 5e7672cc..3532b81d 100644 --- a/vav_pipeline/test/liveness_test.exs +++ b/vav_pipeline/test/liveness_test.exs @@ -22,6 +22,9 @@ defmodule VavPipeline.LivenessTest do setup do # Make sure no provision exists — the exact state of a fresh pod. File.rm(VavPipeline.Manna.provision_file()) + # ...and no halt. halt_monitor_test leaves the monitor halted on some + # seeds (0, 191243), and a fresh pod is not halted. + if HaltMonitor.halted?(), do: HaltMonitor.resolve("liveness test setup") :ok end diff --git a/vav_pipeline/test/tablet33_engine_roots_test.exs b/vav_pipeline/test/tablet33_engine_roots_test.exs new file mode 100644 index 00000000..6ede0a0b --- /dev/null +++ b/vav_pipeline/test/tablet33_engine_roots_test.exs @@ -0,0 +1,131 @@ +defmodule VavPipeline.Tablet33EngineRootsTest do + @moduledoc """ + Tablet 33 (2026-10-04) — the Shoresh Engine now hears roots from L1 + (shoresh-engine `Shoresh.Roots`), and its answers changed shape in three + ways the cycle must carry faithfully: + + * a root may be two letters (`כל`), exactly as L1 records it — no + padded He; + * `binyan` is null for a noun, and for any word not in the verse; + * a root heard through a word's lemma (`לבבך` → `לבב`) arrives with the + `surface` word it was heard from, because L1 records no shoresh on + the suffixed noun and the verse cannot be searched by shoresh. + + The engine's own behaviour is held by its HSpec suite (55 examples). + This file holds the pipeline's reading of it, with an engine-shaped + stand-in under the real port name answering as the rebuilt engine + answered for Devarim 6:5 on 2026-10-04. + """ + + use ExUnit.Case, async: false + + import Plug.Test + import Plug.Conn + + alias VavPipeline.{HaltMonitor, MannaLedger} + alias VavPipeline.BigdeiKodesh.Router + + @opts Router.init([]) + + defmodule EnginePort do + use GenServer + + def start, do: GenServer.start(__MODULE__, :ok, name: VavPipeline.ShoreshEnginePort) + + @impl true + def init(:ok), do: {:ok, :ok} + + @impl true + def handle_call({:request, _json_line}, _from, s) do + roots = [ + root(["aleph", "he", "bet"], "אהב", 8, "Qal", "ואהבת", "verse"), + root(["kaf", "lamed"], "כל", 50, nil, "בכל", "verse"), + root(["lamed", "bet", "bet"], "לבב", 34, nil, "לבבך", "lemma") + ] + + {:reply, {:ok, %{"roots_activated" => roots, "parse_tree" => nil, "dual_readings" => []}}, s} + end + + defp root(letters, hebrew, gematria, binyan, surface, derivation) do + %{ + "shoresh" => letters, + "shoresh_hebrew" => hebrew, + "gematria_value" => gematria, + "binyan" => binyan, + "domain" => "unknown", + "torah_refs" => [], + "neighbors" => [], + "gematria_neighbors" => [], + "surface" => surface, + "derivation" => derivation + } + end + end + + setup do + if HaltMonitor.halted?(), do: HaltMonitor.resolve("tablet33 test setup") + write_provision(50) + + assert Process.whereis(VavPipeline.ShoreshEnginePort) == nil + {:ok, pid} = EnginePort.start() + on_exit(fn -> if Process.alive?(pid), do: GenServer.stop(pid) end) + :ok + end + + test "Devarim 6:5 — the engine's roots are placed in the verse and said plainly" do + conn = post_ask("devarim 6:5") + body = Jason.decode!(conn.resp_body) + answer = body["answer"] + + assert conn.status == 200, "#{conn.status} #{conn.resp_body}" + + # A verb in the verse: binyan and position. + assert answer =~ "א-ה-ב (gematria 8, Qal, word 1)" + + # A two-letter root stays two letters, and stands where L1 says: בכל + # is word 5, ובכל words 7 and 9. + assert answer =~ "כ-ל (gematria 50, word 5, 7, 9)" + + # Heard through the lemma; L1 gives לבבך no shoresh, so only the + # surface word can place it. Word 6 — not "not in this verse". + assert answer =~ "ל-ב-ב (gematria 34, word 6)" + + refute answer =~ "not in this verse" + refute answer =~ "binyan unknown" + assert body["processing"]["roots_consulted"] == ["א-ה-ב", "כ-ל", "ל-ב-ב"] + end + + defp write_provision(compute_units) do + MannaLedger.reset() + on_exit(fn -> MannaLedger.reset() end) + today = Date.utc_today() |> Date.to_iso8601() + expires = DateTime.utc_now() |> DateTime.add(6 * 3600) |> DateTime.to_iso8601() + + provision = %{ + "date" => today, + "provision" => %{ + "compute_units" => compute_units, + "memory_mb" => 512, + "api_calls_external" => 5, + "storage_delta_mb" => 2, + "sanhedrin_panels_max" => 2 + }, + "type" => "regular", + "expires_at" => expires, + "written_by" => "tablet33_test", + "written_at" => DateTime.utc_now() |> DateTime.to_iso8601() + } + + path = VavPipeline.Manna.provision_file() + File.mkdir_p!(Path.dirname(path)) + File.write!(path, Jason.encode!(provision)) + on_exit(fn -> File.rm(path) end) + path + end + + defp post_ask(question) do + conn(:post, "/peah/ask", Jason.encode!(%{question: question})) + |> put_req_header("content-type", "application/json") + |> Router.call(@opts) + end +end