From f1ef408f4ce1674dac9e4512f85093f98cc1f092 Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Thu, 14 Mar 2013 23:08:39 -0400 Subject: [PATCH] Several small bug fixes --- bin/interpreter.py | 12 ++++++++++++ src/Dyna/Analysis/ANF.hs | 13 ++++++++++--- src/Dyna/Backend/Python.hs | 2 ++ src/Dyna/ParserHS/Parser.hs | 7 +++++-- src/Dyna/ParserHS/Selftest.hs | 10 +++++----- 5 files changed, 34 insertions(+), 10 deletions(-) diff --git a/bin/interpreter.py b/bin/interpreter.py index 72c92a0..5544120 100644 --- 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 c59ad1b..9012a0c 100644 --- 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 33db864..e0fba72 100644 --- 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 97a40c6..ae0051e 100644 --- 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 8b431cb..ac12fd4 100644 --- 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) -- 2.50.1