Several small bug fixes

diff --git a/bin/interpreter.py b/bin/interpreter.py
index 72c92a0615408d9722a5b4049be830146a3cca6e..5544120e6cc378f8dbf9ef3a1cc017998abfd605 100644 (file)
--- a/bin/interpreter.py
+++ b/bin/interpreter.py
@@ -55,6 +55,7 @@ aggregator = aggregator_indirect()
 
 
 chart = chart_indirect()
+
 _delete = False
 agenda = set()
 #aggregator = defaultdict(Counter)
@@ -231,6 +232,14 @@ def peel(fn, item):
     functor/arity, `fn`. Returns the arguments of term as a tuple of intern idxs
     and constants (possibly an empty tuple).
     """
+
+    if fn == "true/0" :
+      assert (item is True)
+      return
+    if fn == "false/0" :
+      assert (item is False)
+      return
+
     assert isinstance(item, tuple)
     (fa, idx) = item
     assert fa == fn
@@ -238,6 +247,9 @@ def peel(fn, item):
 
 
 def build(fn, *args):
+    if fn == "true/0" : return True
+    if fn == "false/0" : return False
+
     idx = chart[fn].lookup(args)
     if idx is None:
         idx = chart[fn].insert(args, None)   # don't know val yet.

diff --git a/src/Dyna/Analysis/ANF.hs b/src/Dyna/Analysis/ANF.hs
index c59ad1be03b3e782e08b8716c2fa63c05cba7f57..9012a0c4e0eaee22fe615e0c95e4f68f4e158956 100644 (file)
--- a/src/Dyna/Analysis/ANF.hs
+++ b/src/Dyna/Analysis/ANF.hs
@@ -47,6 +47,8 @@
 -- structured term.  None of our as_* fields give us that guarantee.  See
 -- "Dyna.Backend.Python"'s @findHeadFA@ function.
 
+-- XXX This module does not use Control.Lens but should.
+
 -- FIXME: "str" is the same a constant str.
 
 --     timv: should there ever be more than one side condition? shouldn't it be
@@ -83,6 +85,7 @@ import qualified Data.ByteString.UTF8       as BU
 import qualified Data.ByteString            as B
 import qualified Data.Char                  as C
 import qualified Data.Map                   as M
+-- import qualified Debug.Trace                as XT
 import qualified Dyna.ParserHS.Parser       as P
 import           Dyna.Analysis.Base
 import           Dyna.Term.TTerm
@@ -295,8 +298,8 @@ normTerm_ c   ss (P.TFunctor "*" [t T.:~ st]) =
                 (_,ADEval) -> case nt of
                                 NTVar  v -> NTVar `fmap` newEval "_s" (Left v)
                                 NTBase b -> do
-                                                    newWarn "Ignoring * of literal" ss
-                                                    return $ NTBase b
+                                             newWarn "Ignoring * of literal" ss
+                                             return $ NTBase b
                 _          -> return nt
 
 -- "is/2" is sort of exciting.  We normalize the second argument in an
@@ -343,10 +346,14 @@ normTerm_ c   ss (P.TFunctor f as) = do
     -- pass to strip duplicate vars out.  We need pattern matching to be
     -- linear-with-checks in later pipeline stages so that we can, for
     -- example, correctly reject updates that are not the right shape.
-    normas' <- let delin (vs,r) x = do
+    normas' <- let delin (vs,r) x =
                      case x of
                        NTVar v | not (v `elem` vs) -> do
                             return (v:vs,v:r)
+                       NTVar v -> do
+                            v' <- nextVar "_x"
+                            doUnif v v'
+                            return (vs,v':r)
                        _ -> do
                             v' <- newAssign "_x" (Left x)
                             return (vs,v':r)

diff --git a/src/Dyna/Backend/Python.hs b/src/Dyna/Backend/Python.hs
index 33db8646e7b5c09652ef5b1fadf110532d204dc2..e0fba726c375f9d925d60e1b11b9862cdf0ae43c 100644 (file)
--- a/src/Dyna/Backend/Python.hs
+++ b/src/Dyna/Backend/Python.hs
@@ -86,6 +86,7 @@ constants = S.fromList
     , ("<=",2)
     , (">",2)
     , (">=",2)
+    , ("=",2)
     , ("!",1)
     , ("mod",1)
     , ("abs",1)
@@ -131,6 +132,7 @@ pycall f vs = case (f, length vs) of
   (  "^", 2) -> infixOp " ** "
   (  "&", 2) -> infixOp " and " -- note: python's 'and' and 'or' operate on more than bool
   (  "|", 2) -> infixOp " or "
+  (  "=", 2) -> infixOp " == "
   (  "<", 2) -> infixOp " < "
   ( "<=", 2) -> infixOp " <= "
   (  ">", 2) -> infixOp " > "

diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs
index 97a40c6a4ffca9d4bd77456aeea79154a094ea60..ae0051e7f3af22fecf1ddee03d0dc842a5dc829e 100644 (file)
--- a/src/Dyna/ParserHS/Parser.hs
+++ b/src/Dyna/ParserHS/Parser.hs
@@ -22,6 +22,7 @@
 --      anywhere else in the pipeline yet)
 
 --   Header material                                                      {{{
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -29,6 +30,7 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Dyna.ParserHS.Parser (
@@ -43,6 +45,7 @@ import qualified Data.ByteString.UTF8             as BU
 import qualified Data.ByteString                  as B
 -- import           Data.Char (isSpace)
 import qualified Data.CharSet                     as CS
+import qualified Data.Data                        as D
 import qualified Data.HashSet                     as H
 import           Data.Semigroup ((<>))
 import           Data.Monoid (mempty)
@@ -65,7 +68,7 @@ data Term = TFunctor !B.ByteString
                      !(Spanned Term)
           | TVar     !B.ByteString
           | TBase    !TBase
- deriving (Eq,Ord,Show)
+ deriving (D.Data,D.Typeable,Eq,Ord,Show)
 
 type RuleIx = Int
 
@@ -365,7 +368,7 @@ parseRule = choice [
                -- logical aggregators.
              , do
                   h@(_ :~ s) <- term
-                  ix <- get
+                  ix <- incState
                   return $ Rule ix h ":-" (TFunctor "true" [] :~ s)
              ]
        <* optional (char '.')

diff --git a/src/Dyna/ParserHS/Selftest.hs b/src/Dyna/ParserHS/Selftest.hs
index 8b431cb96d3db54f59aab8ec0e882fdf4c7ad6bc..ac12fd4cc5fce192754a39e91b529cd494b1b85b 100644 (file)
--- a/src/Dyna/ParserHS/Selftest.hs
+++ b/src/Dyna/ParserHS/Selftest.hs
@@ -284,15 +284,15 @@ case_rules = e @=? (proglines sr)
                      (_tNumeric (Left 1) :~ Span (Columns 8 8) (Columns 10 10) sr)
                     :~ s1)
                    :~ s1
-      , LRule (Rule 1 (TFunctor "goal" [] :~ Span (Columns 12 12) (Columns 17 17) sr)
-                    "+="
-                    (_tNumeric (Left 2) :~ Span (Columns 20 20) (Columns 22 22) sr)
+      , LRule (Rule 1 (TFunctor "laog" [] :~ Span (Columns 12 12) (Columns 17 17) sr)
+                    "min="
+                    (_tNumeric (Left 2) :~ Span (Columns 22 22) (Columns 24 24) sr)
                    :~ s2)
                   :~ s2
       ]
   s1 = Span (Columns 0 0) (Columns 11 11) sr
-  s2 = Span (Columns 12 12) (Columns 23 23) sr
-  sr = "goal += 1 . goal += 2 ."
+  s2 = Span (Columns 12 12) (Columns 25 25) sr
+  sr = "goal += 1 . laog min= 2 ."
 
 case_rulesWhitespace :: Assertion
 case_rulesWhitespace = e @=? (proglines sr)