Commit 2423b145 authored by Michael Hanus's avatar Michael Hanus
Browse files

Preprocessor for default rules added

parent 575bf379
......@@ -12,6 +12,7 @@ CASS/cass_worker
curry2js/Curry2JS
currypp/Main
currypp/SequentialRules/Main
currypp/DefaultRules/Transform
currydoc/CurryDoc
currytest/CurryTest
createmakefile/CreateMakefile
......
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
-- The following task should be solved:
-- Break a Curry main expression into an expression and a where...free clause.
-- If the where clause is not present, the returned where-part is empty.
testExps = ["3+4","xs++ys =:= [1,2] where xs,ys free"]
-- FLP solution with default rules:
breakWhereFreeFLP (exp++wf@(" where "++_++" free")) = (exp,wf)
default_breakWhereFreeFLP exp = (exp,"")
main = map breakWhereFreeFLP testExps
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
-- Bubble sort formulation with default rule
import SetFunctions
sort :: [Int] -> [Int]
sort (xs++[x,y]++ys) | x>y = sort (xs++[y,x]++ys)
default_sort xs = xs
mainnd = sort [7,1,6,3,5,4,2]
-- Compute only first value:
main = selectValue (set0 mainnd)
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
-- Dijsktra's Dutch National Flag problem with functional patterns
data Color = Red | White | Blue
-- Formulation with sequential rule application:
solveD (x++[White]++y++[Red ]++z) = solveD (x++[Red]++y++[White]++z)
solveD (x++[Blue ]++y++[Red ]++z) = solveD (x++[Red]++y++[Blue]++z)
solveD (x++[Blue ]++y++[White]++z) = solveD (x++[White]++y++[Blue]++z)
default_solveD flag = flag
uni color = [] ? color : uni color
iflag = [White,Red,White,Blue,Red,Blue,White]
main = solveD iflag
--> [Red,Red,White,White,White,Blue,Blue]
-- but also many more (identical) solutions!
-------------------------------------------------------------------------------
-- Sergio's version to obtain a single solution:
dutch (r@(uni Red) ++ w@(uni White) ++ b@(uni Blue) ++ (Red:xs))
| (w++b==[])=:=False = dutch (Red:r ++ w ++ b ++ xs)
dutch (r@(uni Red) ++ w@(uni White) ++ b@(uni Blue) ++ (White:xs))
| (b==[])=:=False = dutch (r ++ White:w ++ b ++ xs)
default_dutch z = z
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
-- Operation to delete suffixes of the fornm ".0"
fix_int (s++".0") = s
default_fix_int s = s
main = map fix_int ["1.3","1.0","42"]
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
-- Example: predicate to check for float strings
import Char(isDigit)
-- Is the argument a non-negative float string (without exponent)?
-- Our desired notation:
isNNFloat :: String -> Bool
isNNFloat (f1 ++ "." ++ f2) | (all isDigit f1 && all isDigit f2) = True
default_isNNFloat _ = False
main = map isNNFloat ["3.14","314"]
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
{-# OPTIONS_CYMAKE -Wnone #-}
-- Examples for multiple rules with guards:
-- Non-deterministic guard: the non-determinism is encapsulated
zero x | x<0 ? x>0 = "Not zero"
default_zero x = "Zero"
main1 = map zero [-1, 0, 1]
f True _ z | z <= 1 = 1
f _ True z | z > -1 = 2
default_f _ _ _ = 3
main2 = [f True True (-1)
,f True False (-1)
,f True True 0
,f True False 0
,f True True 2
,f False True 0
,f False True 2
]
g x | x==0 = 0
| x==1 = 1
default_g x = 2
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules --optF=-o #-}
{-# OPTIONS_CYMAKE -Wnone #-}
-- This example shows that optimal evaluation is still possible
-- with default rules.
f 0 1 = 0
f _ 2 = 1
default_f _ x = x
-- does not yet work with current transformation scheme, better:
-- rename original rules and introduce single rule for orig. function:
-- f x y = f' x y ? f_default x y
loop = loop
main = [f loop 2, f loop 3]
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
-- Lookup with default rules:
nlookup key (_ ++ [(key,value)] ++ _) = Just value
default_nlookup _ _ = Nothing
main1 = nlookup 3 [] --> Nothing
main2 = nlookup 3 [(1,11),(3,14),(6,7)] --> Just 14
main3 = nlookup 3 [(1,11),(3,14),(6,7),(3,19)] --> Just 14 | Just 19
main4 = nlookup 3 failed
main5 = nlookup () [((),1),(failed,2)] --> Just 1
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
{-# OPTIONS_CYMAKE -Wnone #-}
-- Parallel or with default rules:
por True _ = True
por _ True = True
default_por _ _ = False
main = [por x y | x <- [True,False], y <- [True,False]]
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
{-# OPTIONS_CYMAKE -Wnone #-}
-- Reverse a list if it has exactly two elements:
rev2 [x,y] = [y,x]
default_rev2 xs = xs
main = map rev2 (map (\n->[1..n]) [0..4])
Prelude> BreakWhere> [("3+4",""),("xs++ys =:= [1,2]"," where xs,ys free")]
BreakWhere> BreakWhere> BubbleSort> [1,2,3,4,5,6,7]
BubbleSort> BubbleSort> DutchFlag> [Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
DutchFlag> [Red,Red,White,White,White,Blue,Blue]
DutchFlag> DutchFlag> FloatString> [True,False]
FloatString> FloatString> Guards> ["Not zero","Zero","Not zero"]
Guards> [1,1,1,1,2,2,2]
Guards> Guards> Lookup> Nothing
Lookup> (Just 14)
Lookup> (Just 14)
(Just 19)
Lookup> Lookup> Lookup> Rev2> [[],[1],[2,1],[1,2,3],[1,2,3,4]]
Rev2> Rev2> WorldCup> [("GER","USA",Nothing),("GER","USA",(Just (1,0)))]
WorldCup> WorldCup>
\ No newline at end of file
Loading program "BreakWhere"...
main
[("3+4",[]),("xs++ys =:= [1,2]"," where xs,ys free")]
Loading program "BubbleSort"...
main
[1,2,3,4,5,6,7]
Loading program "DutchFlag"...
main
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
[Red,Red,White,White,White,Blue,Blue]
dutch iflag
[Red,Red,White,White,White,Blue,Blue]
Loading program "FixInt"...
main
["1.3","1","42"]
Loading program "FloatString"...
main
[True,False]
Loading program "Guards"...
main1
["Not zero","Zero","Not zero"]
main2
[1,1,1,1,2,2,2]
[1,1,2,1,2,2,2]
Loading program "Lookup"...
main1
Nothing
main2
Just 14
main3
Just 14
Just 19
main4
Loading program "ParOr"...
main
[True,True,True,False]
[True,True,True,False]
Loading program "Rev2"...
main
[[],[1],[2,1],[1,2,3],[1,2,3,4]]
Loading program "WorldCup"...
main
[("GER","USA",Nothing),("GER","USA",Just (1,0))]
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
-- Example: parse World Cup soccer scores (e.g., "_:_", "3:2")
import Char(isDigit)
parse (team1++" _:_ "++team2) = (team1,team2,Nothing)
parse (team1++[' ',x,':',y,' ']++team2)
| (isDigit x && isDigit y) =:= True
= (team1,team2, Just (toInt x,toInt y))
default_parse _ = error "Wrong format!"
toInt :: Char -> Int
toInt c = ord c - ord '0'
main = [parse "GER _:_ USA",
parse "GER 1:0 USA"]
#!/bin/sh
# Shell script to test the current set of examples
CURRYBIN="../../../../bin"
if [ -x "$CURRYBIN/pakcs" ] ; then
CURRYEXEC=pakcs
CURRYOPTIONS="-q :set v0 :set printdepth 0 :set -free :set +verbose"
elif [ -x "$CURRYBIN/kics2" ] ; then
CURRYEXEC=kics2
CURRYOPTIONS=":set v0 :set -ghci"
else
echo "ERROR: Unknown Curry system!"
exit 1
fi
LOGFILE=xxx$$
PATH=$CURRYBIN:$PATH
export PATH
$CURRYBIN/cleancurry
cat << EOM | $CURRYBIN/$CURRYEXEC $CURRYOPTIONS :set -interactive :set -time | tee $LOGFILE
:load BreakWhere
main
:load BubbleSort
main
:l DutchFlag
main
dutch iflag
:l FixInt
main
:l FloatString
main
:l Guards
main1
main2
:l Lookup
main1
main2
main3
main4
:l ParOr
main
:l Rev2
main
:l WorldCup
main
EOM
################ end of tests ####################
# Check differences:
DIFF=diff$$
diff TESTRESULT.$CURRYEXEC $LOGFILE > $DIFF
if [ "`cat $DIFF`" = "" ] ; then
echo
echo "Regression test successfully executed!"
/bin/rm -f $LOGFILE $DIFF
else
echo
echo "Differences in regression test occurred:"
cat $DIFF
/bin/rm -f $DIFF
/bin/mv -f $LOGFILE LOGFILE
echo "Test output saved in file 'LOGFILE'."
fi
# Makefile for default rules preprocessor
# source modules of the default rules preprocessor:
DEPS = *.curry
TOOL=Transform
.PHONY: all compile install clean uninstall
all: install
install: $(TOOL)
clean:
$(CLEANCURRY) -r
uninstall: clean
rm -f $(TOOL)
# generate executable for Curry Browser:
Transform: $(DEPS)
$(REPL) $(REPL_OPTS) :set -time :load Transform :save :quit
Default Rules Preprocessor
==========================
This directory contains the implementation of a preprocessor
for Curry programs in order to implement default rules.
A default rule for a function `f` processed by this preprocessor
must be defined as a rule defining `default_f` (see the examples
in the directory Examples).
The preprocessor can be called with the following parameters:
... <input> : translate <input> program and show translated program
... -r <input> : translate <input> program and load the translated program
into the Curry system
... <org> <infile> <outfile> : "preprocessor mode", i.e., translate
<infile> to <outfile> where <org> is the original program
-----------------------------------------------------------------------------
--- Translator to implement default rules
-----------------------------------------------------------------------------
import AbstractCurry
import AbstractCurryGoodies