Merge pull request #609 from smucclaw/fendor/backend/simala

Add renamer phase and a simala backend for natural4

This PR introduces two new things:

   * A Renamer/Name resolver phase for Rules
   * A Transpiler which allows transpiling a Rule to a Simala Decl.

The renamer implements lexical scope checking for Hornlike and TypeDecl rules.
It resolves all names, replacing occurrences of each name with its renamed equivalent.
This is supposed to lay the groundwork for a principled transpilation pipeline, avoiding redoing work for each transpiler, such as resolving names, making sure variables are in scope, etc...
In the future, we want to implement a type checker on top of a RnRule. However, that's currently only a dream and there are no attempts of doing any kind of typechecking at the moment.

The simala transpiler solely operates on the renamed rules. This simplifies the implementation a lot, demonstrating how other transpilers may also benefit from the rename phase.
The simala backend can currently only handle Hornlike rules and ignores any kind of TypeDecl rules, as simala is dynamically typed and typechecking should occur in a dedicated rule phase, not ad-hoc in the transpiler.

Both components are somewhat experimental and are expected to have bugs and missing features.

lib/haskell/cabal.project

@@ -27,6 +27,11 @@ source-repository-package
   location: https://github.com/anka-213/haskell-wordnet
   tag: a6d675bcbe1585fc652f95f60e0dec826a660646
 
+source-repository-package
+  type: git
+  location: https://github.com/smucclaw/simala
+  tag: 85afeb86678a65d48bfac2bbb90306693d51582e
+
 allow-newer:
   compact:*,
   udpipe-hs:base,

lib/haskell/natural4/app/Main.hs

@@ -83,6 +83,7 @@ import LS.XPile.Petri (toPetri)
 import LS.XPile.Prolog (rulesToProlog, rulesToSCasp)
 import LS.XPile.Purescript (translate2PS)
 import LS.XPile.SVG qualified as AAS
+import LS.XPile.Simala.Transpile qualified as Simala
 import LS.XPile.Typescript (asTypescript)
 import LS.XPile.Uppaal qualified as Uppaal
 import LS.XPile.VueJSON
@@ -123,6 +124,8 @@ import System.IO.Unsafe (unsafeInterleaveIO)
 import Text.Pretty.Simple (pPrint, pShowNoColor)
 import Text.Regex.PCRE.Heavy qualified as PCRE
 import Text.XML.HXT.Core qualified as HXT
+import qualified LS.Renamer as Renamer
+import LS.Renamer.Rules (RnRule)
 
 --
 -- Command-line options parsing
@@ -275,7 +278,7 @@ main = do
   rc       <- SFL4.getConfig opts
 --  putStrLn "main: doing dumpRules"
   rules    <- SFL4.dumpRules opts
-  let l4i  = l4interpret rules
+  l4i      <- l4interpret rules
   iso8601  <- now8601
 
   -- NLG stuff
@@ -550,6 +553,10 @@ transpilersMap =
     , "an anyall SVG of the decision trees"
     , [aasvgTranspiler]
     )
+  , ( SFL4.simalaMode
+    , "Transpile hornlike rules to the purely functional Simala language"
+    , [simalaTranspiler]
+    )
   ]
 
 toNative :: [SFL4.Rule] -> SFL4.Interpreted -> String
@@ -652,6 +659,13 @@ withNLGData k ds =
     Nothing  -> pure (Skipped "skipping transpiler due to lacking NLG environment")
     Just env -> k env ds
 
+withRnRules :: ([RnRule] -> (TranspilationResult a)) -> DriverState -> (TranspilationResult a)
+withRnRules k ds = case ds.interpreted.renamedRules of
+  Renamer.RenamerFail errMsg _scope -> Skipped $ "Failed to rename rules: " <> errorToString errMsg
+  Renamer.RenamerSuccess rnRules _scope -> k rnRules
+  where
+    errorToString = Text.unpack . Renamer.renderRenamerError
+
 simpleTranspiler ::
      FilePath
   -> String
@@ -1109,6 +1123,14 @@ aasvgTranspiler =
           Nothing ->
             pure () -- no on-screen output
 
+simalaTranspiler :: Transpiler
+simalaTranspiler =
+  simpleTranspiler "simala" "simala" (withRnRules runSimalaTranspiler)
+  where
+    runSimalaTranspiler rnRules = case Simala.runSimalaTranspiler rnRules of
+      Left err -> mkResultWithErrors ("", lines $ Text.unpack $ Simala.renderTranspilerError err)
+      Right decls -> mkResultWithoutErrors (Text.unpack $ Simala.render decls)
+
 rulesTranspiler :: Transpiler
 rulesTranspiler =
   screenTranspiler "rules" (withoutErrors (onlyRules id))

lib/haskell/natural4/package.yaml

@@ -25,6 +25,7 @@ description: natural4 parses a Legal Spreadsheet's CSV and transpiles to multipl
 dependencies:
   - base >= 4.7 && < 5
   - containers
+  - co-log-core
   - unordered-containers
   - hashable
   - flow
@@ -95,6 +96,8 @@ dependencies:
   # - holmes
 # Note: when adding `extra-deps` in `stack.yaml`, have to add them under the relevant package in `package.yaml` too
 # See https://docs.haskellstack.org/en/stable/stack_yaml_vs_cabal_package_file/#why-specify-dependencies-twice
+  # Dependencies specific to the WIP simala backend
+  - simala
 
 language: GHC2021
 

lib/haskell/natural4/src/LS/Interpreter.hs

@@ -112,6 +112,9 @@ import LS.RelationalPredicates
     getBSR,
     partitionExistentials,
   )
+import LS.Renamer.Rules (RnRule)
+import qualified LS.Renamer as Renamer
+import qualified LS.Renamer.Scope as Scope
 import LS.Rule
   ( Rule
       ( DefTypically,
@@ -216,7 +219,6 @@ import LS.XPile.Logging
 import Text.Pretty.Simple (pShowNoColor)
 import Text.Regex.PCRE.Heavy qualified as PCRE
 
-
 -- | This is generated by the Interpreter and handed around to different transpilers.
 --
 -- In the future we may add to this list of attributes the following frequently called functions:
@@ -242,6 +244,8 @@ data Interpreted = L4I {
   -- eliminated. [TODO].
   , origrules  :: [Rule]
 
+  , renamedRules :: Renamer.RenamerResult [RnRule]
+
   -- | valuepredicates contain the bulk of the top-level decision logic, and can be easily expressed as instance or class methosd.
   , valuePreds :: [ValuePredicate]
 
@@ -257,6 +261,7 @@ defaultL4I = L4I
   { classtable = CT Map.empty
   , scopetable = Map.empty
   , origrules = mempty
+  , renamedRules = Renamer.RenamerSuccess mempty Scope.emptyScope
   , valuePreds = mempty
   , ruleGraph = Gr.empty
   , ruleGraphErr = mempty
@@ -280,22 +285,24 @@ type RuleGraph = Gr Rule RuleGraphEdgeLabel
 -- handed to each transpiler for use, as an `l4i` argument.
 --
 
-l4interpret :: [Rule] -> Interpreted
-l4interpret rs =
+l4interpret :: [Rule] -> IO Interpreted
+l4interpret rs = do
   let ct :: ClsTab
       ct = classHierarchy rs
       st :: ScopeTabs
       st = symbolTable rs
       (vp, _vpErr) = xpLog $ attrsAsMethods rs
       (rDGout, rDGerr) = xpLog $ ruleDecisionGraph rs
-  in
-    L4I { classtable = ct
-        , scopetable = st
-        , origrules  = rs
-        , valuePreds = fromRight [] vp
-        , ruleGraph  = rDGout
-        , ruleGraphErr = rDGerr
-        }
+  rnRules <- Renamer.runRenamerFor mempty rs
+
+  pure L4I { classtable = ct
+           , scopetable = st
+           , origrules  = rs
+           , renamedRules = rnRules
+           , valuePreds = fromRight [] vp
+           , ruleGraph  = rDGout
+           , ruleGraphErr = rDGerr
+           }
 
 -- | Provide the fully expanded, exposed, decision roots of all rules in the ruleset,
 --   grouped ("nubbed") into rule groups (since multiple rules may have the same decision body).
@@ -1151,7 +1158,7 @@ globalFacts l4i = do
           pure $ Node pt []
       }
 
--- * Extract everything that looks like a method.
+-- | Extract everything that looks like a method.
 --
 -- A common form is:
 -- @
@@ -1166,7 +1173,7 @@ globalFacts l4i = do
 --    [([ClassA, RecordAttr, AttributeName], foo, Just bar
 -- @
 --
--- | we extract the methods to a fully qualified and annotatable form defined as `ValuePredicate` -- see Types.hs
+-- we extract the methods to a fully qualified and annotatable form defined as `ValuePredicate` -- see Types.hs
 --
 -- Go through every rule and break it down into this structure.
 

lib/haskell/natural4/src/LS/Lib.hs

@@ -65,6 +65,7 @@ module LS.Lib
     vueMode,
     pursMode,
     uppaalMode,
+    simalaMode,
     defaultModes,
     knownModes
   )
@@ -419,6 +420,7 @@ defaultModes =
   , mathlangmwMode
   , genmathlangMode
   , introMode
+  , simalaMode
   ]
 
 -- | All known modes, including ones that are off by default.
@@ -547,6 +549,9 @@ genmathlangMode = MkModeName "genmathlang"
 introMode :: ModeName
 introMode = MkModeName "intro"
 
+simalaMode :: ModeName
+simalaMode = MkModeName "simala"
+
 getConfig :: Options -> IO RunConfig
 getConfig o = do
   mpd <- lookupEnv "MP_DEBUG"

lib/haskell/natural4/src/LS/Log.hs

@@ -0,0 +1,43 @@
+module LS.Log (
+  -- * Logger Type and utility functions
+  Tracer (..),
+  traceWith,
+  cmap,
+  module CoFunctor,
+
+  -- * Experimental logger backends
+  prettyTracer,
+)
+where
+
+import Data.Functor.Contravariant as CoFunctor
+import Prettyprinter
+import Prettyprinter.Render.Text (renderStrict)
+import System.IO (stderr)
+import qualified Data.Text.IO as Text
+
+newtype Tracer m a = Tracer {runTracer :: a -> m ()}
+
+instance Contravariant (Tracer m) where
+  contramap f (Tracer m) = Tracer (m . f)
+
+instance (Applicative m) => Semigroup (Tracer m a) where
+  tracer1 <> tracer2 = Tracer $ \a -> runTracer tracer1 a *> runTracer tracer2 a
+
+instance (Applicative m) => Monoid (Tracer m a) where
+  mempty = Tracer $ \_ -> pure ()
+
+traceWith :: Tracer m a -> a -> m ()
+traceWith tracer msg = runTracer tracer msg
+
+-- | Shorter name for 'contramap' specialised to
+cmap :: forall a' a m. (a' -> a) -> Tracer m a -> Tracer m a'
+cmap = contramap
+
+prettyTracer :: (Pretty a) => Tracer IO a
+prettyTracer =
+  Tracer $
+    Text.hPutStrLn stderr
+      . renderStrict
+      . layoutPretty defaultLayoutOptions
+      . pretty