add a bunch of old files
This commit is contained in:
parent
aeb2f06a2a
commit
0de0726474
|
@ -0,0 +1,103 @@
|
||||||
|
# https://askubuntu.com/a/1360466
|
||||||
|
|
||||||
|
# remove pages by range: 1-2,3,5,6-8
|
||||||
|
# what about 1-2,4,2-4
|
||||||
|
# what about 1,1
|
||||||
|
# landscape/portrait option to pdfnup
|
||||||
|
# outfile
|
||||||
|
# tempfile name (default: ./.temp.pdf)
|
||||||
|
# infile
|
||||||
|
# inplace (in which case CROPPED,INFILE,OUTFILE would be same
|
||||||
|
# margin (single val or ltrb)
|
||||||
|
# ie, 10
|
||||||
|
# 10 15 10 15
|
||||||
|
# number of pages (default 2x1)
|
||||||
|
#
|
||||||
|
# getopt input.pdf output.pdf [--landscape]
|
||||||
|
|
||||||
|
#INFILE="in.pdf"
|
||||||
|
#CROPPED="cropped.pdf"
|
||||||
|
#OUTFILE="outnx1.pdf"
|
||||||
|
#pdfcrop --margins 10 $INFILE $CROPPED
|
||||||
|
#./pdfnup --nup 2x1 $CROPPED -o $OUTFILE --landscape
|
||||||
|
|
||||||
|
DEBUG=
|
||||||
|
|
||||||
|
# Handle optional arguments
|
||||||
|
LANDSCAPE=
|
||||||
|
PAGES=
|
||||||
|
CROPPED=./cropped.pdf
|
||||||
|
SELECTED=./selected.pdf
|
||||||
|
LAYOUT="2x1"
|
||||||
|
GETARGS=$(getopt -o 'r:o::' -l 'margins:,pages:,layout:,landscape::' -- $@) || exit
|
||||||
|
eval "set -- $GETARGS"
|
||||||
|
|
||||||
|
while true; do
|
||||||
|
case $1 in
|
||||||
|
(--margins)
|
||||||
|
MARGINS=$2
|
||||||
|
shift 2;;
|
||||||
|
(--layout)
|
||||||
|
LAYOUT=$2
|
||||||
|
shift 2;;
|
||||||
|
(--pages)
|
||||||
|
PAGES=$2
|
||||||
|
shift 2;;
|
||||||
|
(--landscape)
|
||||||
|
LANDSCAPE=1
|
||||||
|
shift 2;;
|
||||||
|
(--)
|
||||||
|
# opt args parsed
|
||||||
|
shift
|
||||||
|
break;;
|
||||||
|
*)
|
||||||
|
echo "Uh-oh.. Something went wrong.."
|
||||||
|
exit 1;
|
||||||
|
esac
|
||||||
|
#shift 2
|
||||||
|
done;
|
||||||
|
|
||||||
|
echo "REMARGS: $@"
|
||||||
|
|
||||||
|
function echoyn {
|
||||||
|
if [ $1 ]; then
|
||||||
|
echo $1
|
||||||
|
else
|
||||||
|
echo "N"
|
||||||
|
fi
|
||||||
|
}
|
||||||
|
|
||||||
|
if [ $# -lt 2 ]; then
|
||||||
|
echo "Not enough positional args"
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
|
INFILE=$1
|
||||||
|
OUTFILE=$2
|
||||||
|
|
||||||
|
# select: in ->
|
||||||
|
# crop: ->
|
||||||
|
# layout: -> out
|
||||||
|
|
||||||
|
# Use only selected pages if needed if needed
|
||||||
|
if [ $PAGES ]; then
|
||||||
|
gs -sDEVICE=pdfwrite -dNOPAUSE -dBATCH -sPageList=$PAGES -sOutputFile=$INFILE $SELECTED > /dev/null
|
||||||
|
else
|
||||||
|
SELECTED=$INFILE
|
||||||
|
fi
|
||||||
|
|
||||||
|
# Crop if needed
|
||||||
|
if [ $MARGINS ]; then
|
||||||
|
pdfcrop --margins $MARGINS $SELECTED $CROPPED
|
||||||
|
else
|
||||||
|
CROPPED=$SELECTED
|
||||||
|
fi
|
||||||
|
|
||||||
|
if [ $LANDSCAPE ]; then
|
||||||
|
./pdfnup --nup $LAYOUT $CROPPED -o $OUTFILE --landscape
|
||||||
|
else
|
||||||
|
./pdfnup --nup $LAYOUT $CROPPED -o $OUTFILE
|
||||||
|
fi
|
||||||
|
|
||||||
|
# Clean up
|
||||||
|
rm -f $CROPPED $SELECTED
|
|
@ -0,0 +1,46 @@
|
||||||
|
# Tool for simulating verilog
|
||||||
|
EXEFILE_VSIM ?= iverilog
|
||||||
|
|
||||||
|
# Path to bsim
|
||||||
|
EXEFILE_VSIM ?= bsim
|
||||||
|
|
||||||
|
|
||||||
|
all: compile link sim
|
||||||
|
|
||||||
|
compile:
|
||||||
|
@echo Compiling for Bluesim ...
|
||||||
|
bsc -u -sim $(BSCDIRS_BSIM) $(BSCFLAGS) -p $(BSCPATH_BSIM) $(TOPFILE)
|
||||||
|
@echo Compilation for Bluesim finished
|
||||||
|
|
||||||
|
link:
|
||||||
|
@echo Linking for Bluesim ...
|
||||||
|
bsc -sim -parallel-sim-link 8\
|
||||||
|
$(BSCDIRS_BSIM) -p $(BSCPATH_BSIM) \
|
||||||
|
-e $(TOPMODULE) -o ./$(EXEFILE_BSIM) \
|
||||||
|
-keep-fires \
|
||||||
|
$(BSC_C_FLAGS)
|
||||||
|
@echo Linking for Bluesim finished
|
||||||
|
|
||||||
|
sim:
|
||||||
|
@echo Simulation in Bluesim...
|
||||||
|
./$(EXEFILE_BSIM)
|
||||||
|
@echo Simulation in Bluesim finished
|
||||||
|
|
||||||
|
vall: v_compile v_link v_sim
|
||||||
|
|
||||||
|
v_compile: build_v verilog
|
||||||
|
@echo "Compiling for Verilog (Verilog generation) ..."
|
||||||
|
bsc -u -elab -verilog $(BSCDIRS_V) $(BSCFLAGS) -p $(BSCPATH_V) $(TOPFILE)
|
||||||
|
@echo Verilog generation finished
|
||||||
|
|
||||||
|
v_link:
|
||||||
|
@echo Linking for Verilog simulation ...
|
||||||
|
bsc -verilog -vsim $(VSIM) $(BSCDIRS_V) \
|
||||||
|
-e $(TOPMODULE) -o ./$(EXEFILE_VSIM) \
|
||||||
|
-keep-fires
|
||||||
|
@echo Linking for Verilog simulation finished
|
||||||
|
|
||||||
|
v_sim:
|
||||||
|
@echo Verilog simulation ...
|
||||||
|
./$(EXEFILE_VSIM)
|
||||||
|
@echo Verilog simulation finished
|
|
@ -0,0 +1,131 @@
|
||||||
|
/*
|
||||||
|
https://github.com/rsnikhil/RISCV_ISA_Formal_Spec_in_BSV/blob/master/RISCV_Spec/RISCV_Spec.bsv
|
||||||
|
https://github.com/rsnikhil/RISCV_ISA_Formal_Spec_in_BSV/blob/master/RISCV_Spec/ISA_Decls.bsv
|
||||||
|
*/
|
||||||
|
|
||||||
|
package Instr;
|
||||||
|
import Ainstr :: *;
|
||||||
|
import Cinstr :: *;
|
||||||
|
|
||||||
|
/* typedef Bit#(16) Instr; */
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
Bit#(1) ac;
|
||||||
|
union tagged {
|
||||||
|
Ainstr::T;
|
||||||
|
Cinstr::T;
|
||||||
|
}
|
||||||
|
} T deriving Bits;
|
||||||
|
endpackage: Instr
|
||||||
|
|
||||||
|
package Ainstr;
|
||||||
|
typedef struct {
|
||||||
|
Bit#(15) loc;
|
||||||
|
} T deriving Bits;
|
||||||
|
|
||||||
|
function Bit#(15) loc(T ai) = ai::loc;
|
||||||
|
endpackage: Ainstr
|
||||||
|
|
||||||
|
package Cinstr;
|
||||||
|
typedef struct {
|
||||||
|
Bit#(1) zx;
|
||||||
|
Bit#(1) nx;
|
||||||
|
Bit#(1) zy;
|
||||||
|
Bit#(1) ny;
|
||||||
|
Bit#(1) f;
|
||||||
|
Bit#(1) no;
|
||||||
|
} Comp deriving Bits;
|
||||||
|
|
||||||
|
// Fields of C-instruction
|
||||||
|
typedef Bit#(1) A; // `a' value
|
||||||
|
typedef Bit#(3) Dest; // Destination register
|
||||||
|
typedef Bit#(3) Jump; // Jump target
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
Reserved#(2) dummy; // unused bits
|
||||||
|
Instr::A a;
|
||||||
|
Instr::Comp comp;
|
||||||
|
Instr::Dest dest;
|
||||||
|
Instr::Jump jump;
|
||||||
|
} T deriving Bits;
|
||||||
|
|
||||||
|
function A a(T ci) = ci::a;
|
||||||
|
function Comp comp(T ci) = ci::comp;
|
||||||
|
function Dest dest(T ci) = ci::dest;
|
||||||
|
function Jump jump(T ci) = ci::jump;
|
||||||
|
|
||||||
|
/* function A a(T i) = i[12]; */
|
||||||
|
/* function Comp comp(T i) = i[11:6]; */
|
||||||
|
/* function Dest dest(T i) = i[5:3]; */
|
||||||
|
/* function Jump jump(T i) = i[2:0]; */
|
||||||
|
|
||||||
|
// A -> Comp ->
|
||||||
|
/* function Instr encode(A a, Comp c, Dest d, Jump j); */
|
||||||
|
endpackage: cinstr
|
||||||
|
|
||||||
|
package hack;
|
||||||
|
// ALU
|
||||||
|
function Tuple3#(Bit#(16), // out
|
||||||
|
Bit#(1), // zr: Set if out is zero
|
||||||
|
Bit#(1)) // ng: Set if out is negative
|
||||||
|
alu(Bit#(16) x,
|
||||||
|
Bit#(16) y,
|
||||||
|
Bit#(1) zx, // Zero x input
|
||||||
|
Bit#(1) nx, // Negate x input
|
||||||
|
Bit#(1) zy, // Zero y input
|
||||||
|
Bit#(1) ny, // Negate y input
|
||||||
|
Bit#(1) f, // x+y if set, else x&&y
|
||||||
|
Bit#(1) no); // Negate out value
|
||||||
|
Bit#(16) out=0;
|
||||||
|
Bit#(1) zr=0;
|
||||||
|
Bit#(1) ng=0;
|
||||||
|
|
||||||
|
if(zx) x=0;
|
||||||
|
if(nx) x=!x;
|
||||||
|
if(zy) y=0;
|
||||||
|
if(ny) y=!y;
|
||||||
|
|
||||||
|
if(f) out=x+y;
|
||||||
|
else out=x&y;
|
||||||
|
|
||||||
|
if(no) out=!out;
|
||||||
|
|
||||||
|
if(out==0) zr=1;
|
||||||
|
else zr=0;
|
||||||
|
|
||||||
|
if(out<0) ng=1;
|
||||||
|
else ng=0;
|
||||||
|
|
||||||
|
return tuple3(out, zr, ng);
|
||||||
|
endfunction
|
||||||
|
|
||||||
|
import Instr :: *;
|
||||||
|
|
||||||
|
function Tuple4#(Bit#(16), Bit#(1), Bit#(15), Bit#(15))
|
||||||
|
alufn(Bit#(16) inM, Bit#(16) instr, Bit#(1) reset);
|
||||||
|
|
||||||
|
endfunction
|
||||||
|
|
||||||
|
|
||||||
|
interface CPU_I;
|
||||||
|
method Action start(
|
||||||
|
Bit#(16) inM,
|
||||||
|
Instr::T instr,
|
||||||
|
Bit#(1) rst // reset
|
||||||
|
);
|
||||||
|
method #(Bit#(16)) getOutM();
|
||||||
|
method #(Bit#(1)) getWriteM();
|
||||||
|
method #(Bit#(15)) getAddrM();
|
||||||
|
method #(Bit#(15)) getPC();
|
||||||
|
endinterface: CPU_I
|
||||||
|
|
||||||
|
module cpu(CPU_I);
|
||||||
|
Reg#(Bit#(16)) PC;
|
||||||
|
Reg#(Bit#(16)) D;
|
||||||
|
Reg#(Bit#(16)) M;
|
||||||
|
|
||||||
|
method Action start(Bit#(16) inM, Instr::T instr, Bit#(1) rst);
|
||||||
|
|
||||||
|
endmodule: cpu
|
||||||
|
|
||||||
|
endpackage: hack
|
|
@ -0,0 +1,21 @@
|
||||||
|
#include<stdio.h>
|
||||||
|
int main(void)
|
||||||
|
{
|
||||||
|
char *ptr = (char *)malloc(sizeof(char) * 2);
|
||||||
|
ptr[0] = '0';
|
||||||
|
ptr[1] = '1';
|
||||||
|
printf("'%c'\n", ptr[0]);
|
||||||
|
printf("'%c'\n", ptr[1]);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
int *ptr = (int *)malloc(sizeof(ptr) * 2);
|
||||||
|
ptr[0] = 0;
|
||||||
|
ptr[1] = 1;
|
||||||
|
printf("%d\n", ptr[0]);
|
||||||
|
printf("%d\n", ptr[1]);
|
||||||
|
*/
|
||||||
|
//free(ptr);
|
||||||
|
return 0;
|
||||||
|
}
|
|
@ -0,0 +1,15 @@
|
||||||
|
#include<stdio.h>
|
||||||
|
void foo() { }
|
||||||
|
int main() {
|
||||||
|
void a = foo();
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
void-rv-assign.c:4:10: error: variable or field ‘a’ declared void
|
||||||
|
void a = foo();
|
||||||
|
^
|
||||||
|
void-rv-assign.c:4:14: error: void value not ignored as it ought to be
|
||||||
|
void a = foo();
|
||||||
|
^~~
|
||||||
|
*/
|
|
@ -0,0 +1,33 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
module FIR where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
dotp :: (SaturatingNum a, KnownNat n)
|
||||||
|
=> Vec (n + 1) a
|
||||||
|
-> Vec (n + 1) a
|
||||||
|
-> a
|
||||||
|
dotp as bs = fold boundedAdd (Clash.Prelude.zipWith boundedMul as bs)
|
||||||
|
|
||||||
|
fir
|
||||||
|
:: ( HiddenClockResetEnable tag
|
||||||
|
, Default a
|
||||||
|
, KnownNat n
|
||||||
|
, SaturatingNum a
|
||||||
|
, NFDataX a )
|
||||||
|
=> Vec (n + 1) a -> Signal tag a -> Signal tag a
|
||||||
|
fir coeffs x_t = y_t
|
||||||
|
where
|
||||||
|
y_t = dotp coeffs <$> bundle xs
|
||||||
|
xs = window x_t
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Signed 16)
|
||||||
|
-> Signal System (Signed 16)
|
||||||
|
topEntity = exposeClockResetEnable (fir (2:>3:>(-2):>8:>Nil))
|
|
@ -0,0 +1,30 @@
|
||||||
|
module ListState where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
tf
|
||||||
|
:: (Ord a, Num a)
|
||||||
|
=> ()
|
||||||
|
-> [a]
|
||||||
|
-> ((), Bool)
|
||||||
|
tf s i =
|
||||||
|
if sum i > 10 then ((), True)
|
||||||
|
else ((), True)
|
||||||
|
|
||||||
|
tfun
|
||||||
|
:: SystemClockResetEnable
|
||||||
|
=> Signal System [Int]
|
||||||
|
-> Signal System Bool
|
||||||
|
tfun = mealy tf ()
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System [Int]
|
||||||
|
-> signal System Bool
|
||||||
|
topEntity = exposeClockResetEnable tfun
|
||||||
|
|
||||||
|
{-
|
||||||
|
compiles but doesn't synthesize
|
||||||
|
-}
|
|
@ -0,0 +1,31 @@
|
||||||
|
module ListState where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
import qualified Data.List
|
||||||
|
|
||||||
|
lst = [1,2,3]
|
||||||
|
|
||||||
|
tf
|
||||||
|
:: Int
|
||||||
|
-> ()
|
||||||
|
-> (Int, Int)
|
||||||
|
tf s i = (mod (s+1) 3, (Data.List.!!) lst s)
|
||||||
|
|
||||||
|
tfun
|
||||||
|
:: SystemClockResetEnable
|
||||||
|
=> Signal System ()
|
||||||
|
-> Signal System Int
|
||||||
|
tfun = mealy tf 0
|
||||||
|
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System ()
|
||||||
|
-> Signal System Int
|
||||||
|
topEntity = exposeClockResetEnable tfun
|
||||||
|
|
||||||
|
{-
|
||||||
|
compiles and synthesizes
|
||||||
|
-}
|
|
@ -0,0 +1,28 @@
|
||||||
|
module Mac where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
import Clash.Explicit.Testbench
|
||||||
|
import qualified Data.List as L
|
||||||
|
|
||||||
|
|
||||||
|
tf
|
||||||
|
:: Int
|
||||||
|
-> (Int, Int)
|
||||||
|
-> (Int, Int)
|
||||||
|
tf s (a,b) = (s+a*b, s)
|
||||||
|
|
||||||
|
tfun
|
||||||
|
:: SystemClockResetEnable
|
||||||
|
=> Signal System (Int, Int)
|
||||||
|
-> Signal System Int
|
||||||
|
tfun = mealy tf 0
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Int, Int)
|
||||||
|
-> Signal System Int
|
||||||
|
topEntity = exposeClockResetEnable tfun
|
||||||
|
|
||||||
|
-- L.take 4 $ simulate @System tfun [(1,1),(2,2),(3,3),(4,4)]
|
|
@ -0,0 +1,58 @@
|
||||||
|
import Clash.Prelude
|
||||||
|
import qualified Prelude
|
||||||
|
import qualified Data.List
|
||||||
|
|
||||||
|
-------------------------------------------------------------
|
||||||
|
|
||||||
|
lshift :: [a] -> [Either a b]
|
||||||
|
lshift = Prelude.map Left
|
||||||
|
|
||||||
|
rshift :: [b] -> [Either a b]
|
||||||
|
rshift = Prelude.map Right
|
||||||
|
|
||||||
|
-------------------------------------------------------------
|
||||||
|
|
||||||
|
data Nfa a = Nfa {
|
||||||
|
start :: [a]
|
||||||
|
, final :: [a]
|
||||||
|
, tfun :: a -> Maybe Char -> a -> Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
-------------------------------------------------------------
|
||||||
|
|
||||||
|
eps :: Nfa ()
|
||||||
|
eps = Nfa {
|
||||||
|
start = [()]
|
||||||
|
, final = [()]
|
||||||
|
, tfun = \ s c d -> case (c, s, d) of
|
||||||
|
(Nothing, (), ()) -> True
|
||||||
|
otherwise -> False
|
||||||
|
-- () to () possible but not by consuming `c'
|
||||||
|
}
|
||||||
|
|
||||||
|
char :: (Char -> Bool) -> Nfa Bool
|
||||||
|
char f = Nfa {
|
||||||
|
start = [False]
|
||||||
|
, final = [True]
|
||||||
|
, tfun = \ s c d -> case (c, s, d) of
|
||||||
|
(Just c, False, True) -> f c
|
||||||
|
(Nothing, False, False) -> True
|
||||||
|
(Nothing, True, True) -> True
|
||||||
|
otherwise -> False
|
||||||
|
}
|
||||||
|
|
||||||
|
cat :: Nfa a -> Nfa b -> Nfa (Either a b)
|
||||||
|
cat a1 a2 = Nfa {
|
||||||
|
start = lshift (start a1)
|
||||||
|
, final = rshift (final a2)
|
||||||
|
, tfun = \ s c d -> case (c, s, d) of
|
||||||
|
(Just c, Left s, Left d) -> (tfun a1) s c d
|
||||||
|
(Just c, Right s, Right d) -> (tfun a2) s c d
|
||||||
|
(Nothing, Left s, Right d) ->
|
||||||
|
if (final a1) s && (sta
|
||||||
|
}
|
||||||
|
|
||||||
|
-- if ∃st ∈ (start a1) and st ∈ (final a1) then
|
||||||
|
-- (start a1) ++
|
||||||
|
-- else
|
||||||
|
-- start a1
|
|
@ -0,0 +1,22 @@
|
||||||
|
module OverflowExp where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
topFn :: () -> () -> ((), Word)
|
||||||
|
--topFn _ _ = ((), 18446744073709551615)
|
||||||
|
topFn _ _ = ((), 18446744073709551616)
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System ()
|
||||||
|
-> Signal System Word
|
||||||
|
topEntity = exposeClockResetEnable $ mealy topFn ()
|
||||||
|
|
||||||
|
{-
|
||||||
|
// Outputs
|
||||||
|
, output wire [63:0] result
|
||||||
|
);
|
||||||
|
assign result = 64'd18446744073709551615;
|
||||||
|
-}
|
|
@ -0,0 +1,26 @@
|
||||||
|
module ListState where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
tf
|
||||||
|
:: (KnownNat n, Ord a, Num a)
|
||||||
|
=> ()
|
||||||
|
-> Vec (n+1) a
|
||||||
|
-> ((), Bool)
|
||||||
|
tf s i =
|
||||||
|
if sum i > 10 then ((), True)
|
||||||
|
else ((), True)
|
||||||
|
|
||||||
|
tfun
|
||||||
|
:: SystemClockResetEnable
|
||||||
|
=> Signal System (Vec 2 Int)
|
||||||
|
-> Signal System Bool
|
||||||
|
tfun = mealy tf ()
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Vec 2 Int)
|
||||||
|
-> Signal System Bool
|
||||||
|
topEntity = exposeClockResetEnable tfun
|
|
@ -0,0 +1,41 @@
|
||||||
|
module FSM where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
import qualified Prelude
|
||||||
|
|
||||||
|
data Point a =
|
||||||
|
Pt (a -> Bool)
|
||||||
|
| Yes
|
||||||
|
| No
|
||||||
|
|
||||||
|
getPtFn :: Point a -> (a -> Bool)
|
||||||
|
getPtFn p = case p of
|
||||||
|
Pt f -> f
|
||||||
|
Yes -> \x -> True
|
||||||
|
No -> \x -> False
|
||||||
|
-- getPtFn (Pt f) = f
|
||||||
|
-- getPtFn Yes = \x -> True
|
||||||
|
-- getPtFn No = \x -> False
|
||||||
|
|
||||||
|
|
||||||
|
type State = [Point]
|
||||||
|
|
||||||
|
-- [Pt 0, Pt 1, Pt 2]
|
||||||
|
points = map Pt $ map (==) [0, 1, 2]
|
||||||
|
|
||||||
|
-- ssyes =
|
||||||
|
-- [[Pt 1, Pt 2, Yes],
|
||||||
|
-- [Yes],
|
||||||
|
-- [Pt 2, Yes]]
|
||||||
|
ssyes =
|
||||||
|
[[points!!1, points!!2, Yes],
|
||||||
|
[Yes],
|
||||||
|
[points!!2, Yes]]
|
||||||
|
|
||||||
|
sno = [No] >>= replicate 3
|
||||||
|
|
||||||
|
one
|
||||||
|
:: Eq a
|
||||||
|
=> Point
|
||||||
|
-> a
|
||||||
|
-> State
|
|
@ -0,0 +1,26 @@
|
||||||
|
import Clash.Prelude
|
||||||
|
import Clash.Sized.Vector
|
||||||
|
import Clash.Explicit.Testbench
|
||||||
|
|
||||||
|
sz = 3
|
||||||
|
|
||||||
|
l :: [Int]
|
||||||
|
l = [0, 1, 2, 3, 4, 5]
|
||||||
|
|
||||||
|
v = unsafeFromList l :: Vec sz Int
|
||||||
|
|
||||||
|
|
||||||
|
{-
|
||||||
|
list-to-vec.hs:10:5-20: error: …
|
||||||
|
• No instance for (KnownNat sz1)
|
||||||
|
arising from a use of ‘unsafeFromList’
|
||||||
|
Possible fix:
|
||||||
|
add (KnownNat sz1) to the context of
|
||||||
|
an expression type signature:
|
||||||
|
forall (sz1 :: Nat). Vec sz1 Int
|
||||||
|
• In the expression: unsafeFromList l :: Vec sz Int
|
||||||
|
In an equation for ‘v’: v = unsafeFromList l :: Vec sz Int
|
||||||
|
|
|
||||||
|
Compilation failed.
|
||||||
|
-}
|
||||||
|
|
|
@ -0,0 +1,86 @@
|
||||||
|
import Clash.Prelude
|
||||||
|
-- import Clash.Explicit.Testbench
|
||||||
|
|
||||||
|
data SList a
|
||||||
|
= SNil
|
||||||
|
| SCons !a !(SList a)
|
||||||
|
deriving (NFDataX, Generic)
|
||||||
|
|
||||||
|
isSNil :: SList a -> Bool
|
||||||
|
isSNil sl = case sl of
|
||||||
|
SNil -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
tf :: SList Int -> Int -> (SList Int, Maybe Bool)
|
||||||
|
tf s inp = case s of
|
||||||
|
SCons _ s' -> (s', Just False)
|
||||||
|
SNil -> (SNil, Just True)
|
||||||
|
|
||||||
|
mon
|
||||||
|
:: SystemClockResetEnable
|
||||||
|
=> Signal System Int
|
||||||
|
-> Signal System (Maybe Bool)
|
||||||
|
mon = mealy tf SNil
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System Int
|
||||||
|
-> Signal System (Maybe Bool)
|
||||||
|
topEntity = exposeClockResetEnable mon
|
||||||
|
|
||||||
|
{-
|
||||||
|
|
||||||
|
GHC: Setting up GHC took: 0.662s
|
||||||
|
GHC: Compiling and loading modules took: 1.062s
|
||||||
|
Clash: Parsing and compiling primitives took 0.176s
|
||||||
|
GHC+Clash: Loading modules cumulatively took 2.192s
|
||||||
|
Clash: Compiling Main.topEntity
|
||||||
|
Clash.Normalize.Transformations.Inline(523): InlineNonRep: c$Main.mon_ds[19] already inlined 20 times in: Main.mon[8214565720323816306]
|
||||||
|
. The type of the subject is:
|
||||||
|
|
||||||
|
GHC.Tuple.(,)[3746994889972252676]
|
||||||
|
(Main.SList[8214565720323816301]
|
||||||
|
GHC.Types.Int[3674937295934324766])
|
||||||
|
(GHC.Maybe.Maybe[3674937295934324792]
|
||||||
|
GHC.Types.Bool[3674937295934324744])
|
||||||
|
|
||||||
|
Function Main.mon[8214565720323816306] will not reach a normal form and compilation
|
||||||
|
might fail.
|
||||||
|
|
||||||
|
Run with '-fclash-inline-limit=N' to increase the inline limit to N.
|
||||||
|
Clash.Normalize.Transformations.Inline(523): InlineNonRep: c$Main.mon_ds[19] already inlined 20 times in: Main.mon[8214565720323816306]
|
||||||
|
. The type of the subject is:
|
||||||
|
|
||||||
|
GHC.Tuple.(,)[3746994889972252676]
|
||||||
|
(Main.SList[8214565720323816301]
|
||||||
|
GHC.Types.Int[3674937295934324766])
|
||||||
|
(GHC.Maybe.Maybe[3674937295934324792]
|
||||||
|
GHC.Types.Bool[3674937295934324744])
|
||||||
|
|
||||||
|
Function Main.mon[8214565720323816306] will not reach a normal form and compilation
|
||||||
|
might fail.
|
||||||
|
|
||||||
|
Run with '-fclash-inline-limit=N' to increase the inline limit to N.
|
||||||
|
Clash.Normalize.Transformations.Inline(523): InlineNonRep: c$Main.mon_ds[19] already inlined 20 times in: Main.mon[8214565720323816306]
|
||||||
|
. The type of the subject is:
|
||||||
|
|
||||||
|
GHC.Tuple.(,)[3746994889972252676]
|
||||||
|
(Main.SList[8214565720323816301]
|
||||||
|
GHC.Types.Int[3674937295934324766])
|
||||||
|
(GHC.Maybe.Maybe[3674937295934324792]
|
||||||
|
GHC.Types.Bool[3674937295934324744])
|
||||||
|
|
||||||
|
Function Main.mon[8214565720323816306] will not reach a normal form and compilation
|
||||||
|
might fail.
|
||||||
|
|
||||||
|
Run with '-fclash-inline-limit=N' to increase the inline limit to N.
|
||||||
|
|
||||||
|
<no location info>: error:
|
||||||
|
Clash error call:
|
||||||
|
Clash.Core.Type(395): Report as bug: not a FunTy
|
||||||
|
CallStack (from HasCallStack):
|
||||||
|
error, called at src/Clash/Core/Type.hs:395:20 in clash-lib-1.6.3-4vM2gwSsWPHufxjlmfu4S:Clash.Core.Type
|
||||||
|
|
||||||
|
-}
|
|
@ -0,0 +1,31 @@
|
||||||
|
import Clash.Prelude
|
||||||
|
-- import Clash.Explicit.Testbench
|
||||||
|
|
||||||
|
data SList (n :: Nat) a
|
||||||
|
= SNil
|
||||||
|
| SCons !a !(SList a)
|
||||||
|
deriving (NFDataX, Generic)
|
||||||
|
|
||||||
|
isSNil :: SList a -> Bool
|
||||||
|
isSNil sl = case sl of
|
||||||
|
SNil -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
tf :: SList Int -> Int -> (SList Int, Maybe Bool)
|
||||||
|
tf s inp = case s of
|
||||||
|
SCons _ s' -> (s', Just False)
|
||||||
|
SNil -> (SNil, Just True)
|
||||||
|
|
||||||
|
mon
|
||||||
|
:: SystemClockResetEnable
|
||||||
|
=> Signal System Int
|
||||||
|
-> Signal System (Maybe Bool)
|
||||||
|
mon = mealy tf SNil
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System Int
|
||||||
|
-> Signal System (Maybe Bool)
|
||||||
|
topEntity = exposeClockResetEnable mon
|
|
@ -0,0 +1,23 @@
|
||||||
|
From mathcomp Require Import all_ssreflect.
|
||||||
|
|
||||||
|
Fixpoint twice (n: nat): nat :=
|
||||||
|
if n is n'.+1 then (twice n').+2 else 0.
|
||||||
|
|
||||||
|
Lemma twiceDouble: forall n:nat,
|
||||||
|
twice (2 * n) = twice n + twice n.
|
||||||
|
Proof.
|
||||||
|
elim=> [|n IHn].
|
||||||
|
- done.
|
||||||
|
- rewrite !addSn.
|
||||||
|
rewrite -/twice.
|
||||||
|
rewrite mulnS.
|
||||||
|
rewrite -IHn.
|
||||||
|
Abort.
|
||||||
|
|
||||||
|
Context (A B C: Prop).
|
||||||
|
|
||||||
|
Lemma HilbertS: (A -> B -> C) -> (A -> B) -> A -> C.
|
||||||
|
Proof.
|
||||||
|
move=> Habc Hab.
|
||||||
|
move: Habc.
|
||||||
|
|
|
@ -0,0 +1,39 @@
|
||||||
|
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice.
|
||||||
|
From mathcomp Require Import fintype div tuple bigop prime finset fingroup.
|
||||||
|
From mathcomp Require Import ssralg poly polydiv morphism action finalg zmodp.
|
||||||
|
From mathcomp Require Import cyclic center pgroup abelian matrix mxpoly vector.
|
||||||
|
From mathcomp Require Import falgebra fieldext separable galois.
|
||||||
|
From mathcomp Require ssrnum ssrint algC cyclotomic.
|
||||||
|
|
||||||
|
(* Identity of a group *)
|
||||||
|
Check 1%g.
|
||||||
|
Check 1%R.
|
||||||
|
Check ringType.
|
||||||
|
Check fieldType.
|
||||||
|
(* Got +1,+2,+3,+4 and -1,-2 *)
|
||||||
|
Compute 3.+4.
|
||||||
|
(* = 7 : nat *)
|
||||||
|
|
||||||
|
Print injective.
|
||||||
|
(*
|
||||||
|
injective =
|
||||||
|
fun (rT aT : Type) (f : aT -> rT) =>
|
||||||
|
forall x1 x2 : aT, f x1 = f x2 -> x1 = x2
|
||||||
|
: forall rT aT : Type, (aT -> rT) -> Prop
|
||||||
|
*)
|
||||||
|
|
||||||
|
(* Check fieldExtType. *)
|
||||||
|
Locate "0".
|
||||||
|
Check 0%g.
|
||||||
|
(* Check R. *)
|
||||||
|
|
||||||
|
(* Factorial *)
|
||||||
|
Compute 0`!. (* = 1 : nat *)
|
||||||
|
Compute 1`!. (* = 1 : nat *)
|
||||||
|
Compute 2`!. (* = 2 : nat *)
|
||||||
|
Compute 3`!. (* = 6 : nat *)
|
||||||
|
Compute 4`!. (* = 24 : nat *)
|
||||||
|
|
||||||
|
(* Summation. ie, Σ *)
|
||||||
|
Compute \sum_ (1 <= i < 5) i. (* 1+2+3+4+5 *)
|
||||||
|
Compute \sum_ (1 <= i < 3) (2*i). (* 2*(1+2+3) *)
|
|
@ -0,0 +1,45 @@
|
||||||
|
From mathcomp Require Import all_ssreflect all_algebra.
|
||||||
|
|
||||||
|
Print negbK.
|
||||||
|
Check negbK. (* involutive negb *)
|
||||||
|
Print involutive. (* f (f x) = x *)
|
||||||
|
Print cancel. (* f g such that f (g x) = x *)
|
||||||
|
|
||||||
|
Locate "~~". (* negb *)
|
||||||
|
Locate "~". (* Could be 'not' *)
|
||||||
|
|
||||||
|
Goal forall b: bool,
|
||||||
|
~~ (~~ b) = b.
|
||||||
|
Proof.
|
||||||
|
intro b.
|
||||||
|
case: b.
|
||||||
|
by [].
|
||||||
|
by [].
|
||||||
|
Show Proof.
|
||||||
|
Restart.
|
||||||
|
intro b.
|
||||||
|
by case: b.
|
||||||
|
(* Or 'by [case: b].' *)
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Fixpoint multn (n m: nat): nat :=
|
||||||
|
if n is n'.+1 then m + multn n' m
|
||||||
|
else 0.
|
||||||
|
Compute multn 3 4.
|
||||||
|
(* = 12 : nat *)
|
||||||
|
|
||||||
|
Goal forall n m: nat,
|
||||||
|
(n * m == 0) = (n == 0) || (m == 0).
|
||||||
|
Proof.
|
||||||
|
intros n m.
|
||||||
|
case: n => [|n] //.
|
||||||
|
case: m => [|m]; last first => //. (* Good practice to get rid of easy goal first' *)
|
||||||
|
by rewrite muln0.
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Goal forall n p:nat,
|
||||||
|
prime p -> p %| (n`! + 1) -> n < p.
|
||||||
|
Proof.
|
||||||
|
move => n p prime_p.
|
||||||
|
apply: contraLR.
|
||||||
|
|
|
@ -0,0 +1,22 @@
|
||||||
|
From mathcomp Require Import all_ssreflect all_algebra.
|
||||||
|
|
||||||
|
(* Inductive point: Type := *)
|
||||||
|
(* | Point (x y z: nat). *)
|
||||||
|
|
||||||
|
(* Definition getX (p: point): nat := *)
|
||||||
|
(* let: Point x _ _ := p in x. *)
|
||||||
|
(* Compute getX (Point 1 2 3). *)
|
||||||
|
(* (1* = 1 : nat *1) *)
|
||||||
|
|
||||||
|
Print matrix.
|
||||||
|
|
||||||
|
Variant point: Type :=
|
||||||
|
| Point (x y z: nat).
|
||||||
|
|
||||||
|
Compute 3.+1.
|
||||||
|
(* = 4 : nat *)
|
||||||
|
|
||||||
|
Check point_rect.
|
||||||
|
Check point_ind.
|
||||||
|
Check point_rec.
|
||||||
|
Check point_sind.
|
|
@ -0,0 +1,146 @@
|
||||||
|
(* From Chapter-5 of mathcomp book *)
|
||||||
|
From mathcomp Require Import all_ssreflect.
|
||||||
|
|
||||||
|
Lemma test_reflect (b: bool) (P: Prop):
|
||||||
|
reflect P b -> P \/ ~P.
|
||||||
|
Proof.
|
||||||
|
case.
|
||||||
|
by move=> H; left.
|
||||||
|
by move=> H; right. (* ✓ *)
|
||||||
|
Restart.
|
||||||
|
by case; [left | right].
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Lemma andP (b1 b2: bool): reflect (b1 /\ b2) (b1 && b2).
|
||||||
|
Proof.
|
||||||
|
case: b1.
|
||||||
|
case b2.
|
||||||
|
by left.
|
||||||
|
right.
|
||||||
|
move=> [l r].
|
||||||
|
by [].
|
||||||
|
case b2.
|
||||||
|
right.
|
||||||
|
by move=> [l r].
|
||||||
|
right.
|
||||||
|
move=> [l _].
|
||||||
|
by []. (* ✓ *)
|
||||||
|
Restart.
|
||||||
|
case: b1; case b2.
|
||||||
|
by left.
|
||||||
|
by right; by move=>[l r].
|
||||||
|
by right; by move=>[l r].
|
||||||
|
by right; by move=>[l r]. (* ✓ *)
|
||||||
|
Restart.
|
||||||
|
case: b1; case b2.
|
||||||
|
by left.
|
||||||
|
all: by right; by move=>[l r]. (* ✓ *)
|
||||||
|
(* Restart. *)
|
||||||
|
(* by case: b1; case b2; *)
|
||||||
|
(* [left | right => //= [l r]]. *)
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Lemma orP (b1 b2: bool): reflect (b1 \/ b2) (b1 || b2).
|
||||||
|
Proof.
|
||||||
|
case: b1; case b2.
|
||||||
|
by left; left.
|
||||||
|
by left; left.
|
||||||
|
by left; right.
|
||||||
|
right.
|
||||||
|
move=> [l | r].
|
||||||
|
by case b2.
|
||||||
|
by case b2. (* ✓ *)
|
||||||
|
(* Restart. *)
|
||||||
|
(* case: b1; case b2; [ [left; [left | right]] | right]. *)
|
||||||
|
(* Restart. *)
|
||||||
|
(* case: b1; case b2; *)
|
||||||
|
(* [left; by [move | left | right]]. *)
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Lemma implyP (b1 b2: bool): reflect (b1 -> b2) (b1 ==> b2).
|
||||||
|
Proof.
|
||||||
|
case b1; case b2.
|
||||||
|
by left.
|
||||||
|
right.
|
||||||
|
Search (_ -> _).
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
apply/Bool.ReflectT.
|
||||||
|
move => H.
|
||||||
|
|
||||||
|
rewrite /(_ isT).
|
||||||
|
Abort.
|
||||||
|
|
||||||
|
Lemma nat_inj_eq {A: Type} (f: A -> nat) (x y: A):
|
||||||
|
injective f -> reflect (x=y) (eqn (f x) (f y)).
|
||||||
|
Proof.
|
||||||
|
move=> f_inj.
|
||||||
|
Check eqnP.
|
||||||
|
Check iffP.
|
||||||
|
Check iffP eqnP.
|
||||||
|
apply: (iffP eqnP).
|
||||||
|
apply: f_inj.
|
||||||
|
Search (_ = _ -> _ = _).
|
||||||
|
(* congruence. *)
|
||||||
|
apply: congr1. (* ✓ *)
|
||||||
|
Restart.
|
||||||
|
move => f_inj; apply: (iffP eqnP); [apply: f_inj | apply: congr1].
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Lemma eqnP (n m: nat): reflect (n = m) (eqn n m).
|
||||||
|
Proof.
|
||||||
|
apply: (iffP idP).
|
||||||
|
Abort. (* TODO *)
|
||||||
|
|
||||||
|
Lemma example1 (n m k: nat):
|
||||||
|
k <= n ->
|
||||||
|
(n <= m) && (m <= k) ->
|
||||||
|
n = k.
|
||||||
|
Proof.
|
||||||
|
move=> lekn.
|
||||||
|
Undo.
|
||||||
|
move=> lekn /andP [lenm lemk].
|
||||||
|
Undo.
|
||||||
|
move=> lekn /andP [/eqnP lenm lemk].
|
||||||
|
Abort. (* TODO *)
|
||||||
|
|
||||||
|
Lemma leq_total (n m: nat): (n <= m) || (n >= m).
|
||||||
|
Proof.
|
||||||
|
Abort.
|
||||||
|
|
||||||
|
Locate "_ -> _ ".
|
||||||
|
|
||||||
|
Lemma example2 (a b: bool): a && b ==> (a == b).
|
||||||
|
Proof.
|
||||||
|
case: andP => [ab | nab].
|
||||||
|
Search (reflect (_ = _) _).
|
||||||
|
apply/addbP.
|
||||||
|
Abort.
|
||||||
|
|
||||||
|
(* Euclidean division example *)
|
||||||
|
Definition edivn_rec (d: nat): nat -> nat -> nat * nat :=
|
||||||
|
fix loop (m q: nat): nat * nat :=
|
||||||
|
if m-d is m'.+1 then loop m' q.+1
|
||||||
|
else (q, m).
|
||||||
|
Definition edivn (m d: nat): nat*nat :=
|
||||||
|
if d>0 then edivn_rec d.-1 m 0
|
||||||
|
else (0, m).
|
||||||
|
|
||||||
|
(* Follows from definition but useful to have better control over level of
|
||||||
|
* unfolding in later proof *)
|
||||||
|
Lemma edivn_recE (d m q: nat):
|
||||||
|
edivn_rec d m q =
|
||||||
|
if m-d is m'.+1 then edivn_rec d m' q.+1
|
||||||
|
else (q, m).
|
||||||
|
Proof. by case: m. Qed.
|
||||||
|
|
||||||
|
Lemma edivnP (m d: nat) (ed := edivn m d):
|
||||||
|
((d>0) ==> (ed.2 < d)) && (m == ed.1 * d + ed.2).
|
||||||
|
Proof.
|
|
@ -0,0 +1,59 @@
|
||||||
|
From mathcomp Require Import all_ssreflect.
|
||||||
|
|
||||||
|
Fail Compute \sum_(0 < i < 12.*2 | odd i) i.
|
||||||
|
(* Fail Compute \sum_i(0 < i < 12.*2 | odd i) i. *)
|
||||||
|
|
||||||
|
From CoqEAL Require Import hrel param refinements trivial_seq.
|
||||||
|
From CoqEAL Require Import binnat binint seqpoly binord seqmx.
|
||||||
|
Check refines_rel.
|
||||||
|
|
||||||
|
Check 3.-tuple.
|
||||||
|
Search ".-tuple".
|
||||||
|
Print nil_tuple.
|
||||||
|
Check tval.
|
||||||
|
|
||||||
|
Definition foo (n:nat): n.-tuple bool -> seq bool -> Type :=
|
||||||
|
fun btup bseq => tval btup = bseq.
|
||||||
|
|
||||||
|
|
||||||
|
Lemma sum_odd_n (n: nat): \sum_(0 <= i < n.*2 | odd i) i = n^2.
|
||||||
|
Proof.
|
||||||
|
rewrite unlock.
|
||||||
|
Fail rewrite bigop_unlock.
|
||||||
|
Restart.
|
||||||
|
elim: n.
|
||||||
|
by rewrite unlock /=.
|
||||||
|
rewrite unlock /=.
|
||||||
|
Restart.
|
||||||
|
elim: n => [ | n IH].
|
||||||
|
rewrite double0.
|
||||||
|
rewrite -mulnn muln0.
|
||||||
|
by rewrite big_geq.
|
||||||
|
Check big_ord_recr.
|
||||||
|
Search "big" nat.
|
||||||
|
rewrite -big_ord_recr.
|
||||||
|
rewrite (@big_cat_nat _ _ _ (n.*2)).
|
||||||
|
rewrite big_ord_recr.
|
||||||
|
|
||||||
|
|
||||||
|
(* rewrite unlock. *)
|
||||||
|
Search bigop "_ind".
|
||||||
|
Search bigop "_rec".
|
||||||
|
(* elim/big_ind2. *)
|
||||||
|
(* Search reducebig. *)
|
||||||
|
(* rewrite -bigop_unlock. *)
|
||||||
|
(* move=> n. *)
|
||||||
|
Abort.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Lemma sum_odd_n (n: nat) : \sum_(0 <= i < n.*2 | odd i) i = n^2.
|
||||||
|
Proof.
|
||||||
|
elim: n => [//=|n IH]; first by rewrite double0 -mulnn muln0 big_geq.
|
||||||
|
rewrite (@big_cat_nat _ _ _ n.*2) //=; last by rewrite -!addnn leq_add.
|
||||||
|
rewrite IH -!mulnn mulSnr mulnSr -addnA.
|
||||||
|
congr (_ + _).
|
||||||
|
rewrite big_ltn_cond ?ifF ?odd_double //.
|
||||||
|
rewrite big_ltn_cond /ifT ?oddS ?odd_double //=.
|
||||||
|
by rewrite big_geq ?addn0 -addnn addnS // -addnn addSn.
|
||||||
|
Qed.
|
|
@ -0,0 +1,64 @@
|
||||||
|
Require Import List.
|
||||||
|
Import ListNotations.
|
||||||
|
|
||||||
|
Definition lstHd {A: Type} (ls: list A)
|
||||||
|
: length ls <> 0 -> A.
|
||||||
|
Proof.
|
||||||
|
refine (
|
||||||
|
match ls with
|
||||||
|
| [] => fun pf => _
|
||||||
|
| x :: _ => fun _ => x
|
||||||
|
end).
|
||||||
|
contradiction.
|
||||||
|
Defined.
|
||||||
|
|
||||||
|
Module Vec.
|
||||||
|
Definition t (A: Type) (sz: nat): Type :=
|
||||||
|
{ls: list A | length ls = sz}.
|
||||||
|
|
||||||
|
Context {A: Type} {sz: nat}.
|
||||||
|
|
||||||
|
Definition hd (v: t A (S sz)): A.
|
||||||
|
refine (
|
||||||
|
match v with
|
||||||
|
| exist _ l pf => _
|
||||||
|
end).
|
||||||
|
induction l.
|
||||||
|
- discriminate pf.
|
||||||
|
- exact a.
|
||||||
|
Show Proof.
|
||||||
|
Defined.
|
||||||
|
|
||||||
|
Definition tl (v: t A (S sz)): t A sz.
|
||||||
|
refine (let (l, _) := v in _).
|
||||||
|
induction l.
|
||||||
|
- discriminate e.
|
||||||
|
- simpl in e.
|
||||||
|
Search (S _ = S _).
|
||||||
|
rewrite (PeanoNat.Nat.succ_inj (length l) sz) in e.
|
||||||
|
+
|
||||||
|
f_equal in e.
|
||||||
|
exact (exist _ l .
|
||||||
|
Defined.
|
||||||
|
|
||||||
|
Fixpoint zip {A B: Type} {n:nat}
|
||||||
|
(av: Vec A n) (bv: Vec B n): Vec (A*B) n :=
|
||||||
|
match av with
|
||||||
|
| [] => []
|
||||||
|
| a::av' =>
|
||||||
|
|
||||||
|
Definition dotProduct {n:nat}
|
||||||
|
(v1 v2: Vec bool n): csr.A :=
|
||||||
|
let v12 := zip v1 v2 in
|
||||||
|
let ires := Vector.map (fun '(a, b) => csr.multn a b) v12 in
|
||||||
|
fold_right (fun elem res => csr.addtn elem res) ires csr.zero.
|
||||||
|
End Vec.
|
||||||
|
Definition
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
match av in Vec _ n
|
||||||
|
return Vec B n -> Vec (A*B) n with
|
||||||
|
| [] => fun _ => []
|
||||||
|
| a::av' => fun bv => (a, Vector.hd bv) :: zip av' (Vector.tl bv)
|
||||||
|
end bv.
|
|
@ -0,0 +1,11 @@
|
||||||
|
Module FooMod.
|
||||||
|
#[local] Notation "⊥" := false.
|
||||||
|
|
||||||
|
Check ⊥. (* ⊥ : bool *)
|
||||||
|
|
||||||
|
End FooMod.
|
||||||
|
Disable Notation "+" (all).
|
||||||
|
|
||||||
|
Import FooMod.
|
||||||
|
Compute ⊥.
|
||||||
|
(* Syntax Error: Lexer: Undefined token *)
|
|
@ -0,0 +1,9 @@
|
||||||
|
Inductive colour: Set := Red | Black.
|
||||||
|
|
||||||
|
(* colour of root, black height *)
|
||||||
|
Inductive tree {A:Type}: colour -> nat -> Type :=
|
||||||
|
| Empty: tree Black 0
|
||||||
|
| RNode: forall n:nat,
|
||||||
|
A -> tree Black n -> tree Black n -> tree Red n
|
||||||
|
| BNode: forall (n:nat) (c1 c2:colour),
|
||||||
|
A -> tree c1 n -> tree c2 n -> tree Black n.
|
|
@ -0,0 +1,265 @@
|
||||||
|
Inductive even: nat -> Prop :=
|
||||||
|
| EvenO: even 0
|
||||||
|
| EvenS: forall n:nat,
|
||||||
|
odd n -> even (S n)
|
||||||
|
with odd: nat -> Prop :=
|
||||||
|
| OddS: forall n:nat,
|
||||||
|
even n -> odd (S n).
|
||||||
|
|
||||||
|
(*
|
||||||
|
Print even_ind.
|
||||||
|
Scheme even_ind' := Induction for even Sort Prop.
|
||||||
|
Print even_ind'.
|
||||||
|
*)
|
||||||
|
|
||||||
|
Fixpoint evenb (n:nat): bool :=
|
||||||
|
match n with
|
||||||
|
| O => true
|
||||||
|
| S n' => oddb n'
|
||||||
|
end
|
||||||
|
with oddb (n:nat): bool :=
|
||||||
|
match n with
|
||||||
|
| O => false
|
||||||
|
| S n' => evenb n'
|
||||||
|
end.
|
||||||
|
|
||||||
|
Lemma foo: forall n:nat,
|
||||||
|
evenb n = true -> oddb (S n) = true.
|
||||||
|
Proof.
|
||||||
|
intros n H.
|
||||||
|
induction n.
|
||||||
|
- reflexivity.
|
||||||
|
- simpl.
|
||||||
|
Abort.
|
||||||
|
|
||||||
|
Definition evenBP (n: nat): (evenb n = true <-> even n) /\ (oddb n = true <-> odd n).
|
||||||
|
Proof.
|
||||||
|
induction n.
|
||||||
|
- simpl.
|
||||||
|
split.
|
||||||
|
+ split; intro H; constructor.
|
||||||
|
+ split; intro H; inversion H.
|
||||||
|
- destruct IHn as [[H0 H1] [H2 H3]].
|
||||||
|
simpl.
|
||||||
|
split.
|
||||||
|
+ split.
|
||||||
|
* intro H.
|
||||||
|
constructor.
|
||||||
|
exact (H2 H).
|
||||||
|
* intro H.
|
||||||
|
apply H3.
|
||||||
|
|
||||||
|
Definition evenBP (n: nat): evenb n = true -> even n.
|
||||||
|
Proof.
|
||||||
|
intros H.
|
||||||
|
induction n.
|
||||||
|
- constructor.
|
||||||
|
- apply EvenS.
|
||||||
|
(*
|
||||||
|
1 subgoal
|
||||||
|
|
||||||
|
n : nat
|
||||||
|
H : evenb (S n) = true
|
||||||
|
IHn : evenb n = true -> even n
|
||||||
|
|
||||||
|
========================= (1 / 1)
|
||||||
|
|
||||||
|
odd n
|
||||||
|
*)
|
||||||
|
|
||||||
|
destruct n.
|
||||||
|
+ discriminate.
|
||||||
|
+ simpl in H.
|
||||||
|
simpl.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(***************************************)
|
||||||
|
|
||||||
|
|
||||||
|
Inductive even: nat -> Prop :=
|
||||||
|
| EvenO: even 0
|
||||||
|
| EvenS: forall n:nat,
|
||||||
|
even n -> even (S (S n)).
|
||||||
|
|
||||||
|
Example even256: even 256.
|
||||||
|
Proof.
|
||||||
|
repeat constructor.
|
||||||
|
Show Proof.
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Fixpoint evenb (n:nat): bool :=
|
||||||
|
match n with
|
||||||
|
| O => true
|
||||||
|
| S O => false
|
||||||
|
| S (S n') => evenb n'
|
||||||
|
end.
|
||||||
|
|
||||||
|
Fixpoint evenBP (n: nat): evenb n = true -> even n.
|
||||||
|
Proof.
|
||||||
|
intros H.
|
||||||
|
destruct n as [| [|n]].
|
||||||
|
- constructor.
|
||||||
|
- inversion H.
|
||||||
|
- constructor.
|
||||||
|
simpl in H.
|
||||||
|
exact (evenBP n H).
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Example even256': even 256.
|
||||||
|
Proof.
|
||||||
|
apply (evenBP 256).
|
||||||
|
simpl; reflexivity.
|
||||||
|
Show Proof.
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
(* ✓ *)
|
||||||
|
|
||||||
|
|
||||||
|
(***************************************)
|
||||||
|
|
||||||
|
Inductive even: nat -> Prop :=
|
||||||
|
| EvenO: even 0
|
||||||
|
| EvenS: forall n:nat,
|
||||||
|
even n -> even (S (S n))
|
||||||
|
with odd: nat -> Prop :=
|
||||||
|
| Odd1: odd 1
|
||||||
|
| OddS: forall n:nat,
|
||||||
|
even (S n) -> odd n.
|
||||||
|
|
||||||
|
Fixpoint evenb (n:nat): bool :=
|
||||||
|
match n with
|
||||||
|
| O => true
|
||||||
|
| S O => false
|
||||||
|
| S (S n') => evenb n'
|
||||||
|
end.
|
||||||
|
|
||||||
|
Example even256: even 256.
|
||||||
|
Proof.
|
||||||
|
repeat constructor.
|
||||||
|
Show Proof.
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Lemma foo: forall n:nat,
|
||||||
|
evenb (S n) = negb (evenb n).
|
||||||
|
Proof.
|
||||||
|
intros n.
|
||||||
|
induction n.
|
||||||
|
- simpl; reflexivity.
|
||||||
|
- rewrite IHn.
|
||||||
|
Require Import Bool.
|
||||||
|
rewrite negb_involutive.
|
||||||
|
simpl.
|
||||||
|
reflexivity.
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Theorem evenBP: forall n:nat,
|
||||||
|
evenb n = true -> even n.
|
||||||
|
Proof.
|
||||||
|
intros n H.
|
||||||
|
induction n.
|
||||||
|
- constructor.
|
||||||
|
-
|
||||||
|
|
||||||
|
|
||||||
|
Require Import Bool.
|
||||||
|
Print reflect.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(*********************************************)
|
||||||
|
|
||||||
|
|
||||||
|
Inductive even: nat -> Prop :=
|
||||||
|
| EvenO: even 0
|
||||||
|
| EvenSS: forall n:nat,
|
||||||
|
even n -> even (S (S n)).
|
||||||
|
|
||||||
|
(*
|
||||||
|
Inductive odd: nat -> Prop :=
|
||||||
|
| Odd1: odd (S O)
|
||||||
|
| OddSS: forall n:nat,
|
||||||
|
odd n -> odd (S (S n)).
|
||||||
|
|
||||||
|
Lemma evenSodd: forall n:nat,
|
||||||
|
even n -> odd (S n).
|
||||||
|
Proof.
|
||||||
|
intros n H.
|
||||||
|
induction n.
|
||||||
|
- constructor.
|
||||||
|
- apply OddSS.
|
||||||
|
*)
|
||||||
|
|
||||||
|
Lemma evenS: forall n:nat,
|
||||||
|
even n -> ~(even (S n)).
|
||||||
|
Proof.
|
||||||
|
intros n H.
|
||||||
|
induction n.
|
||||||
|
- intro HH.
|
||||||
|
|
||||||
|
Abort.
|
||||||
|
|
||||||
|
Lemma even256: even 256.
|
||||||
|
Proof.
|
||||||
|
repeat constructor.
|
||||||
|
Show Proof.
|
||||||
|
Qed.
|
||||||
|
|
||||||
|
Fixpoint evenb (n:nat): bool :=
|
||||||
|
match n with
|
||||||
|
| O => true
|
||||||
|
| S O => false
|
||||||
|
| S (S n') => evenb n'
|
||||||
|
end.
|
||||||
|
|
||||||
|
Require Import Arith.
|
||||||
|
Print Nat.even.
|
||||||
|
Print Nat.Even.
|
||||||
|
Search (Nat.Even).
|
||||||
|
Print Nat.even_spec.
|
||||||
|
|
||||||
|
Axiom foo1: forall n:nat,
|
||||||
|
~(even n) -> even (S n).
|
||||||
|
Axiom foo1': forall n:nat,
|
||||||
|
(even n) -> ~(even (S n)).
|
||||||
|
|
||||||
|
Axiom foo2: forall n:nat,
|
||||||
|
evenb n = true -> evenb (S n) = false.
|
||||||
|
|
||||||
|
Theorem evenBP: forall n:nat,
|
||||||
|
evenb n = true -> even n.
|
||||||
|
Proof.
|
||||||
|
intros n H.
|
||||||
|
induction n.
|
||||||
|
- constructor.
|
||||||
|
-
|
||||||
|
(*
|
||||||
|
#+BEGIN_OUTPUT (Goal)
|
||||||
|
1 subgoal
|
||||||
|
|
||||||
|
n : nat
|
||||||
|
H : evenb (S n) = true
|
||||||
|
IHn : evenb n = true -> even n
|
||||||
|
|
||||||
|
========================= (1 / 1)
|
||||||
|
|
||||||
|
even (S n)
|
||||||
|
#+END_OUTPUT (Goal) *)
|
||||||
|
|
||||||
|
destruct IHn.
|
||||||
|
pose proof (foo2 (S n) H).
|
||||||
|
inversion H.
|
||||||
|
|
||||||
|
apply foo1.
|
||||||
|
intro HH.
|
||||||
|
apply IHn.
|
||||||
|
|
||||||
|
o
|
|
@ -0,0 +1,103 @@
|
||||||
|
(* ** Strictly decreasing [list nat] *)
|
||||||
|
|
||||||
|
(*
|
||||||
|
l MAX: non empty list
|
||||||
|
|
||||||
|
l n
|
||||||
|
| start: l n
|
||||||
|
| cons: n >= m ->
|
||||||
|
|
|
||||||
|
|
||||||
|
repeat:
|
||||||
|
| Repeat: forall n>1 ∧ n<4, tok -> repeat
|
||||||
|
|
||||||
|
repeat:
|
||||||
|
| R1one: one -> repeat
|
||||||
|
| R1oth: other -> repeat
|
||||||
|
| R2: other -> repeat
|
||||||
|
| R3: other -> repeat.
|
||||||
|
|
||||||
|
*)
|
||||||
|
Inductive foo: nat -> nat -> Type :=
|
||||||
|
| Foo: forall n m:nat, n > m -> foo n m.
|
||||||
|
|
||||||
|
Inductive bar: nat -> Type :=
|
||||||
|
| Bar: forall n:nat, bar n.
|
||||||
|
|
||||||
|
Inductive decrList: nat -> Type :=
|
||||||
|
| DEmpty: decrList 0
|
||||||
|
| DCons: forall n m:nat,
|
||||||
|
foo n m -> bar m -> decrList n -> decrList m.
|
||||||
|
|
||||||
|
Check DCons 0 0 (Foo _ _ _) (Bar _) DEmpty.
|
||||||
|
Check DCons 3 0 (Foo _ _ _) (Bar _).
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
pre := I | X | C
|
||||||
|
one := D | L | V
|
||||||
|
thrice := M | pre
|
||||||
|
all := M | pre | once
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
subpair := IV | IX
|
||||||
|
XL | XC
|
||||||
|
CD | CM
|
||||||
|
one := D | L | V
|
||||||
|
|
||||||
|
No symbol occurs more than thrice consecutively: https://www.numere-romane.ro/rule2-repetition-of-basic-symbols-in-roman-numerals.php?lang=en
|
||||||
|
|
||||||
|
MCX use instead of:
|
||||||
|
'M, C, and X cannot be equalled or exceeded by smaller denominations.'
|
||||||
|
- X: VV
|
||||||
|
- M: C * 10 ✓
|
||||||
|
- C: X * 10 ✓
|
||||||
|
|
||||||
|
num := all
|
||||||
|
|
||||||
|
additive notation, subtractive notation
|
||||||
|
*)
|
||||||
|
|
||||||
|
Inductive other: Set := V | L | D | M.
|
||||||
|
Inductive subpre := I | X | C.
|
||||||
|
Inductive tok: Set :=
|
||||||
|
| Other: other -> tok
|
||||||
|
| SubPre: subpre -> tok.
|
||||||
|
|
||||||
|
Definition val (n:tok): nat :=
|
||||||
|
match n with
|
||||||
|
| Other x =>
|
||||||
|
match x with
|
||||||
|
| V => 5
|
||||||
|
| L => 50
|
||||||
|
| D => 500
|
||||||
|
| M => 1000
|
||||||
|
end
|
||||||
|
| SubPre x =>
|
||||||
|
match x with
|
||||||
|
| I => 1
|
||||||
|
| X => 10
|
||||||
|
| C => 100
|
||||||
|
end
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
Inductive rnumSub: Set :=
|
||||||
|
| RSub: subpre -> tok -> rnumSub.
|
||||||
|
|
||||||
|
Inductive rnum: Type :=
|
||||||
|
| RNil: rnum
|
||||||
|
| RCons: other -> rnum -> rnum
|
||||||
|
| RSubCons: rnumSub -> rnum -> rnum.
|
||||||
|
|
||||||
|
(*
|
||||||
|
CDXCIX
|
||||||
|
|
||||||
|
|
||||||
|
*)
|
||||||
|
Example eg1 := RSub I (SubPre X). (* IX *)
|
||||||
|
Example eg2 := RSub X (SubPre C). (* XC *)
|
||||||
|
Example eg3 := RSub C (Other D). (* XC *)
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,15 @@
|
||||||
|
Inductive term: Type :=
|
||||||
|
| Var: nat -> term
|
||||||
|
| Abs: term -> term
|
||||||
|
| App: term -> term -> term.
|
||||||
|
|
||||||
|
Notation "'λ' body" := (Abs body) (at level 60, right associativity).
|
||||||
|
Notation "'❨' t1 t2 '❩'" := (App t1 t2) (at level 50).
|
||||||
|
Notation "'`' varidx " := (Var varidx) (at level 40).
|
||||||
|
|
||||||
|
Check λ`0.
|
||||||
|
Check λ❨`0 `0❩.
|
||||||
|
Check ❨λ❨`0 `0❩ λ❨`0 `0❩❩.
|
||||||
|
|
||||||
|
Require Import List.
|
||||||
|
Search In.
|
|
@ -0,0 +1,52 @@
|
||||||
|
-- https://github.com/compiling-to-categories/concat/blob/84900a2937cdfdfe7fcc773f18b4a4ddcf5251ee/classes/src/ConCat/Category.hs
|
||||||
|
|
||||||
|
{-# LANGUAGE DeriveFoldable #-}
|
||||||
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
{-# LANGUAGE UndecidableSuperClasses #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
{-# LANGUAGE PolyKinds #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE DefaultSignatures #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
{-# LANGUAGE RecursiveDo #-}
|
||||||
|
{-# LANGUAGE NoStarIsType #-}
|
||||||
|
|
||||||
|
infixr 9 ∘
|
||||||
|
infixr 3 △
|
||||||
|
|
||||||
|
class Category k where
|
||||||
|
id :: k a a
|
||||||
|
(∘) :: k b c -> k a b -> k a c
|
||||||
|
|
||||||
|
class Category k => Cartesian k where
|
||||||
|
(△) :: k a b -> k a c -> k a (b,c)
|
||||||
|
-- I wonder why ex{l,r} was chosen as the name
|
||||||
|
exl :: k (a,b) a
|
||||||
|
exr :: k (a,b) b
|
||||||
|
|
||||||
|
instance Category (->) where
|
||||||
|
id = \x -> x
|
||||||
|
g ∘ f = \x -> g (f x)
|
||||||
|
|
||||||
|
instance Cartesian (->) where
|
||||||
|
f △ g = \x -> (f x, g x)
|
||||||
|
exl = \(a, _) -> a
|
||||||
|
exr = \(_, b) -> b
|
|
@ -0,0 +1,21 @@
|
||||||
|
import System.Environment
|
||||||
|
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
progName <- getProgName
|
||||||
|
putStrLn "Prog name:"
|
||||||
|
putStrLn progName
|
||||||
|
putStrLn "Args:"
|
||||||
|
mapM putStrLn args
|
||||||
|
|
||||||
|
{-
|
||||||
|
./a.out hello world
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
Prog name:
|
||||||
|
a.out
|
||||||
|
Args:
|
||||||
|
hello
|
||||||
|
world
|
||||||
|
-}
|
|
@ -0,0 +1,28 @@
|
||||||
|
data Expr f = In (f (Expr f))
|
||||||
|
data Val e = ValC Int
|
||||||
|
type IntExpr = Expr Val
|
||||||
|
|
||||||
|
-- λ> In (ValC 3)
|
||||||
|
-- In (ValC 3) :: Expr Val
|
||||||
|
|
||||||
|
data Add e = AddC e e
|
||||||
|
type AddExpr = Expr Add
|
||||||
|
|
||||||
|
-- In (_: Add (Expr Add))
|
||||||
|
-- In $ AddC (_: Expr Add) (_: Expr Add)
|
||||||
|
|
||||||
|
-- λ> In (AddC (In (ValC 2)) (In (ValC 3)))
|
||||||
|
|
||||||
|
data (f :+: g) e
|
||||||
|
= Inl (f e)
|
||||||
|
| Inr (g e)
|
||||||
|
|
||||||
|
type IntAddExpr = Expr (Val :+: Add)
|
||||||
|
-- In (Inr _)
|
||||||
|
-- In (Inr AddC (In (Inl (ValC 2)))
|
||||||
|
-- (In (Inl (ValC 3))))
|
||||||
|
|
||||||
|
|
||||||
|
a = In (Inr (AddC (In (Inl (ValC 2))) (In (Inl (ValC 3)))))
|
||||||
|
b = In $ Inr $ AddC (In (Inl (ValC 2))) (In (Inl (ValC 3)))
|
||||||
|
c = In $ Inr $ AddC (In $ Inl $ ValC 2) (In $ Inl $ ValC 3)
|
|
@ -0,0 +1,25 @@
|
||||||
|
import Data.Set
|
||||||
|
|
||||||
|
data DFA = DFA {
|
||||||
|
states :: Set String
|
||||||
|
, sigma :: Set String
|
||||||
|
, tf :: String -> String -> String
|
||||||
|
, strt :: String
|
||||||
|
, final :: Set String
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Show DFA where
|
||||||
|
show x = show states ++
|
||||||
|
show sigma ++
|
||||||
|
"tf" ++ strt ++
|
||||||
|
show final
|
||||||
|
|
||||||
|
tf1 "q0" "1" = "q1"
|
||||||
|
tf1 "q1" "0" = "q0"
|
||||||
|
|
||||||
|
a = fromList [1,1,2,3]
|
||||||
|
dfa = DFA (fromList ["q0", "q1", "q2", "q3"])
|
||||||
|
(fromList ["0", "1"])
|
||||||
|
tf1
|
||||||
|
"q0"
|
||||||
|
(fromList ["q3"])
|
|
@ -0,0 +1,4 @@
|
||||||
|
main = do
|
||||||
|
putStrLn "Enter your name: "
|
||||||
|
name <- getLine
|
||||||
|
putStrLn ("Hi " ++ name ++ "! Good day.")
|
|
@ -0,0 +1,30 @@
|
||||||
|
import Data.Dynamic
|
||||||
|
-- import Data.Maybe
|
||||||
|
|
||||||
|
type Result = [Row]
|
||||||
|
type Row = HList
|
||||||
|
type HList = [Dynamic]
|
||||||
|
|
||||||
|
angus = [ toDyn 42, toDyn True]
|
||||||
|
|
||||||
|
--hCount :: Typeable a => HList -> [a]
|
||||||
|
|
||||||
|
-- Haskell record
|
||||||
|
data Unpriced = Unpriced { key :: Integer
|
||||||
|
, name :: String }
|
||||||
|
|
||||||
|
angus = Unpriced { key = 42
|
||||||
|
, name = "angus" }
|
||||||
|
|
||||||
|
-- > key angus
|
||||||
|
-- 42
|
||||||
|
-- > name angus
|
||||||
|
-- angus
|
||||||
|
|
||||||
|
-- Update record
|
||||||
|
notAngus = angus { key = 32 }
|
||||||
|
-- > key angus
|
||||||
|
-- 32
|
||||||
|
-- > name angus
|
||||||
|
-- angus
|
||||||
|
|
|
@ -0,0 +1,114 @@
|
||||||
|
-- monadic parsing
|
||||||
|
-- https://bitbucket.org/piyush-kurur/functional-programming/raw/a2b004847c92f88aa6ae3073f4d230b3a770cad8/notes/live.org
|
||||||
|
-- Graham Hutton book (2e)
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Data.Char
|
||||||
|
|
||||||
|
-- | Result of parsing
|
||||||
|
data Result a = OK a String -- ^ Parsed data
|
||||||
|
| Error String -- ^ error message
|
||||||
|
|
||||||
|
-- | Parser capable of parsing a value of type `a`
|
||||||
|
newtype Parser a = Parser {runParser :: String -> Result a}
|
||||||
|
|
||||||
|
instance Functor Result where
|
||||||
|
-- fmap :: (a -> b) -> Result a -> Result b
|
||||||
|
fmap f (OK a s) = OK (f a) s
|
||||||
|
fmap _ (Error msg) = Error msg
|
||||||
|
--fmap _ obj = obj
|
||||||
|
|
||||||
|
instance Applicative Result where
|
||||||
|
-- pure :: a -> Result a
|
||||||
|
pure x = OK x ""
|
||||||
|
|
||||||
|
-- (<*>) :: Result (a -> b) -> Result a -> Result b
|
||||||
|
(OK fa2b rem) <*> a = fa2b <$> a
|
||||||
|
(Error msg) <*> _ = Error msg
|
||||||
|
|
||||||
|
instance Functor Parser where
|
||||||
|
-- fmap :: (a -> b) -> Parser a -> Parser b
|
||||||
|
fmap f (Parser pa) = Parser pb
|
||||||
|
where
|
||||||
|
pb inp = f <$> pa inp
|
||||||
|
|
||||||
|
instance Applicative Parser where
|
||||||
|
-- pure :: a -> Parser a
|
||||||
|
-- insert a value `x` of type `a` to the parsed part
|
||||||
|
pure x = Parser (\inp -> OK x inp)
|
||||||
|
|
||||||
|
-- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
|
||||||
|
(Parser pa2b) <*> (Parser pa) = Parser pb
|
||||||
|
where
|
||||||
|
-- `pb inp` should be of type `Result b`
|
||||||
|
pb inp = case pa2b inp of
|
||||||
|
-- fa2b :: a -> b
|
||||||
|
-- rem :: String
|
||||||
|
--
|
||||||
|
-- attempt to parse rem as a, which is then
|
||||||
|
-- passed to fa2b to make it b
|
||||||
|
-- `pa rem` is of type `Result a`
|
||||||
|
-- `fa2b <$> pa rem` is of type `Result b`
|
||||||
|
OK fa2b rem -> fa2b <$> (pa rem)
|
||||||
|
Error msg -> Error msg
|
||||||
|
|
||||||
|
instance Monad Parser where
|
||||||
|
-- Context sensitive parsing as ppk said
|
||||||
|
-- (>>=) :: Parser a -> (a -> Parser b) -> (Parser b)
|
||||||
|
(Parser pa) >>= fa2pb = Parser pb
|
||||||
|
where
|
||||||
|
-- fa2b :: a -> Parser b
|
||||||
|
pb inp = case pa inp of
|
||||||
|
-- `fa2pb a` is of type `Parser b`
|
||||||
|
-- `runParser $ fa2pb a` is of type `String -> Result b`
|
||||||
|
OK a rem -> (runParser $ fa2pb a) rem
|
||||||
|
Error msg -> Error msg
|
||||||
|
|
||||||
|
instance Alternative Parser where
|
||||||
|
-- empty :: Parser a
|
||||||
|
empty = Parser (\inp -> Error "empty!")
|
||||||
|
|
||||||
|
-- (<|>) :: Parser a -> Parser a -> Parser a
|
||||||
|
-- Try parsing with first parser, if that fails
|
||||||
|
-- try parsing with the next parser.
|
||||||
|
(Parser px) <|> (Parser py) = Parser pz
|
||||||
|
where
|
||||||
|
pz inp = case px inp of
|
||||||
|
OK xval rem -> OK xval rem
|
||||||
|
Error _ ->
|
||||||
|
case py inp of
|
||||||
|
OK yval rem -> OK yval rem
|
||||||
|
Error msg -> Error msg
|
||||||
|
|
||||||
|
{-
|
||||||
|
satisfy :: Char -> String -> Result a
|
||||||
|
-- `x` is `Char`
|
||||||
|
satisfy ch (x:rem) = if ch==x then OK x rem
|
||||||
|
else Error "err"
|
||||||
|
|
||||||
|
helloP = Parser
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- parse :: Parser a -> String -> [(a, String)]
|
||||||
|
-- -- p :: String -> [(a, String)]
|
||||||
|
-- parse (Parser p) inp = p inp
|
||||||
|
--
|
||||||
|
-- item :: Parser Char
|
||||||
|
-- item = Parser (\inp -> case inp of
|
||||||
|
-- [] -> []
|
||||||
|
-- (x:xs) -> [(x, xs)])
|
||||||
|
-- -- λ> parse item "hello"
|
||||||
|
-- -- [('h',"ello")]
|
||||||
|
--
|
||||||
|
-- instance Functor Parser where
|
||||||
|
-- -- fmap :: (a -> b) -> Parser a -> Parser b
|
||||||
|
-- fmap f pp = Parser (\inp ->
|
||||||
|
-- case parse pp inp of
|
||||||
|
-- [] -> []
|
||||||
|
-- [(x,xs)] -> [(f x,xs)])
|
|
@ -0,0 +1,34 @@
|
||||||
|
{- | Find factorial -}
|
||||||
|
fact :: Int -- ^ Integer whose factorial is to be found
|
||||||
|
-> Int -- ^ Factorial value
|
||||||
|
fact n
|
||||||
|
| n > 1 = n * fact (n - 1)
|
||||||
|
| n <= 1 = 1
|
||||||
|
|
||||||
|
{- | No error handling
|
||||||
|
|
||||||
|
|
||||||
|
Used div instead of / to get integer result instead of float.
|
||||||
|
|
||||||
|
Example:
|
||||||
|
|
||||||
|
> p 9 4
|
||||||
|
3024
|
||||||
|
-}
|
||||||
|
p :: Int -- ^ n
|
||||||
|
-> Int -- ^ r
|
||||||
|
-> Int -- ^ nPr
|
||||||
|
p n r
|
||||||
|
| n > r && r >= 0 = (fact n) `div` fact (n - r)
|
||||||
|
-- | n == (r + 1) = 1
|
||||||
|
-- | n > r = n * (p (n-1) r)
|
||||||
|
|
||||||
|
{- | No error handling
|
||||||
|
|
||||||
|
Example:
|
||||||
|
|
||||||
|
-}
|
||||||
|
c :: Int -- ^ n
|
||||||
|
-> Int -- ^ r
|
||||||
|
-> Int -- ^ nCr
|
||||||
|
c n r = (p n r) `div` (fact r)
|
|
@ -0,0 +1,76 @@
|
||||||
|
-- | Find number to base b
|
||||||
|
bin
|
||||||
|
:: Int -- ^ number n
|
||||||
|
-> [Int] -- ^ digits of n in binary as list. LSB first.
|
||||||
|
bin n
|
||||||
|
| n==0 = [0]
|
||||||
|
| otherwise = helper n
|
||||||
|
where
|
||||||
|
helper n
|
||||||
|
| n==0 = []
|
||||||
|
| otherwise = rem:helper nxt
|
||||||
|
where
|
||||||
|
rem = mod n 2
|
||||||
|
nxt = quot n 2
|
||||||
|
|
||||||
|
-- | Find value for aCb where a and b ∈ {0, 1}
|
||||||
|
nCkBin
|
||||||
|
:: (Int, Int) -- ^ a and b values as tuple
|
||||||
|
-> Int -- ^ aCb value
|
||||||
|
nCkBin (0, 1) = 0
|
||||||
|
nCkBin _ = 1
|
||||||
|
|
||||||
|
-- | Calculate nCr value
|
||||||
|
nCr
|
||||||
|
:: Int -- ^ n
|
||||||
|
-> Int -- ^ r
|
||||||
|
-> Int -- ^ nCr
|
||||||
|
nCr a b = product $ map nCkBin $ zip apad bpad
|
||||||
|
where
|
||||||
|
abin = bin a
|
||||||
|
bbin = bin b
|
||||||
|
alen = length abin
|
||||||
|
blen = length bbin
|
||||||
|
maxlen = max alen blen
|
||||||
|
apad = abin ++ replicate (maxlen-alen) 0
|
||||||
|
bpad = bbin ++ replicate (maxlen-blen) 0
|
||||||
|
|
||||||
|
-- | Find values for one level
|
||||||
|
oneLine
|
||||||
|
:: Int -- ^ current level
|
||||||
|
-> [Int] -- ^ values of the level
|
||||||
|
oneLine lvl = [nCr lvl r | r <- [0..lvl]]
|
||||||
|
|
||||||
|
-- | Find values of all levels
|
||||||
|
allLines
|
||||||
|
:: Int -- ^ maximum level
|
||||||
|
-> [[Int]] -- ^ values of levels. Values of each level is in a separate list
|
||||||
|
allLines maxLvl = [oneLine i | i <- [0..maxLvl]]
|
||||||
|
|
||||||
|
-- | Find values of a level and format it as a string
|
||||||
|
fmtOneLine
|
||||||
|
:: Int -- ^ maximum level
|
||||||
|
-> Int -- ^ current level
|
||||||
|
-> String -- ^ formatted string
|
||||||
|
fmtOneLine maxLvl lvl = begg ++ bodyhead ++ bodytail
|
||||||
|
where
|
||||||
|
begg = replicate (maxLvl-lvl) ' '
|
||||||
|
digitstr = map show $ oneLine lvl
|
||||||
|
bodyhead = head digitstr
|
||||||
|
bodytail = foldl (++) "" $ map ((++) " ") $ tail digitstr
|
||||||
|
|
||||||
|
|
||||||
|
-- | Find values of the entire Pascal triangle and format it as a string
|
||||||
|
fmtAllLines
|
||||||
|
:: Int -- ^ maximum level
|
||||||
|
-> String -- ^ formatted, read-to-print, string
|
||||||
|
fmtAllLines maxLvl = foldl (++) "" $ map ((++) "\n") strLines
|
||||||
|
where
|
||||||
|
strLines = [fmtOneLine maxLvl lvl | lvl <- [0..maxLvl]]
|
||||||
|
|
||||||
|
main = do
|
||||||
|
putStrLn "Enter max level:"
|
||||||
|
maxLevelStr <- getLine
|
||||||
|
let maxLevel = read maxLevelStr :: Int
|
||||||
|
let ll = allLines maxLevel
|
||||||
|
putStrLn $ fmtAllLines maxLevel
|
|
@ -0,0 +1,16 @@
|
||||||
|
-- {-# TemplateHaskell #-}
|
||||||
|
import Clash.Prelude
|
||||||
|
import Clash.Sized.Vector
|
||||||
|
import Language.Haskell.TH
|
||||||
|
import Language.Haskell.TH.Syntax
|
||||||
|
|
||||||
|
-- v1 = $(listToVecTH [0,1])
|
||||||
|
|
||||||
|
|
||||||
|
{-
|
||||||
|
λ> :t $(listToVecTH [0,1])
|
||||||
|
$(listToVecTH [0,1]) :: Num a => Vec 2 a
|
||||||
|
|
||||||
|
λ> $(listToVecTH [0,1])
|
||||||
|
0 :> 1 :> Nil
|
||||||
|
-}
|
|
@ -0,0 +1,8 @@
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
|
module TH where
|
||||||
|
|
||||||
|
import Language.Haskell.TH
|
||||||
|
|
||||||
|
someSplice :: Q [Dec]
|
||||||
|
someSplice = [d|y = 0|]
|
|
@ -0,0 +1,34 @@
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
|
|
||||||
|
import Language.Haskell.TH
|
||||||
|
|
||||||
|
import TH
|
||||||
|
|
||||||
|
x :: Int
|
||||||
|
x = 42
|
||||||
|
|
||||||
|
$someSplice
|
||||||
|
|
||||||
|
z :: String
|
||||||
|
z = show x
|
||||||
|
|
||||||
|
|
||||||
|
-- import Language.Haskell.TH
|
||||||
|
-- import Language.Haskell.TH.Syntax
|
||||||
|
|
||||||
|
-- someSplice :: Q [Dec]
|
||||||
|
-- someSplice = [d| y = 0 |]
|
||||||
|
|
||||||
|
-- -- $(someSplice)
|
||||||
|
|
||||||
|
-- {-
|
||||||
|
-- GHC stage restriction:
|
||||||
|
-- ‘someSplice’ is used in a top-level splice, quasi-quote, or annotation,
|
||||||
|
-- and must be imported, not defined locally
|
||||||
|
-- |
|
||||||
|
-- 9 | $(someSplice)
|
||||||
|
|
||||||
|
-- -}
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
data Color = Red | Yellow | Green
|
||||||
|
|
||||||
|
-- | Light state
|
||||||
|
-- Format: CurrentNext
|
||||||
|
data LState = RY | YG | G | YR
|
||||||
|
|
||||||
|
controller :: LState -> () -> (LState, Color)
|
||||||
|
controller RY _ = (YG, Yellow)
|
||||||
|
controller YG _ = (G, Green)
|
||||||
|
controller G _ = (YR, Yellow)
|
||||||
|
controller YR _ = (RY, Red)
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,19 @@
|
||||||
|
require "io"
|
||||||
|
--input = io.read()
|
||||||
|
if package.loaded.io then
|
||||||
|
print("io module loaded.")
|
||||||
|
else
|
||||||
|
print("io module not loaded.")
|
||||||
|
end
|
||||||
|
|
||||||
|
--[[
|
||||||
|
s = "1950/01/26"
|
||||||
|
print(s:match("^%d+"))
|
||||||
|
_, i = s:find("^%d/")
|
||||||
|
print(_, i)
|
||||||
|
s = s:sub(i+1)
|
||||||
|
print(s)
|
||||||
|
--]]
|
||||||
|
|
||||||
|
-- s = "01-Mar-2018"
|
||||||
|
-- s:match("^%d%d",
|
|
@ -0,0 +1,11 @@
|
||||||
|
seednum = io.read()
|
||||||
|
math.randomseed(seednum)
|
||||||
|
|
||||||
|
local counter = 0
|
||||||
|
repeat
|
||||||
|
local n = math.random(6)
|
||||||
|
print(n)
|
||||||
|
counter = counter + 1
|
||||||
|
until n==6
|
||||||
|
|
||||||
|
print(counter)
|
|
@ -0,0 +1,5 @@
|
||||||
|
a = {}
|
||||||
|
for i=1,5 do
|
||||||
|
--io.write("Enter element number " .. i)
|
||||||
|
a[i] = io.read()
|
||||||
|
end
|
|
@ -0,0 +1,24 @@
|
||||||
|
let rec fact n =
|
||||||
|
if n < 1 then 1
|
||||||
|
else n * (fact (n-1))
|
||||||
|
|
||||||
|
let x = fact 5;;
|
||||||
|
(*
|
||||||
|
The double semicolon is needed above.
|
||||||
|
|
||||||
|
This may be related:
|
||||||
|
http://ocamlverse.net/content/faq_if_semicolon.html
|
||||||
|
*)
|
||||||
|
Printf.printf "%d" x
|
||||||
|
(* 120 *)
|
||||||
|
|
||||||
|
(*************************************************)
|
||||||
|
|
||||||
|
(* https://github.com/wiredsister/example-ocaml/blob/master/examples/factorial.ml *)
|
||||||
|
let rec fact2 = function
|
||||||
|
| 0 -> 1
|
||||||
|
| n when n>1 -> n * (fact2 (n-1))
|
||||||
|
| _ -> 0;;
|
||||||
|
|
||||||
|
Printf.printf "%d" (fact 6)
|
||||||
|
(* 720 *)
|
|
@ -0,0 +1,57 @@
|
||||||
|
(*
|
||||||
|
https://www.cis.upenn.edu/~bcpierce/tapl/checkers/untyped/
|
||||||
|
https://web.archive.org/web/20210423155718/https://www.cis.upenn.edu/~bcpierce/tapl/checkers/
|
||||||
|
*)
|
||||||
|
|
||||||
|
(* ** Compilation
|
||||||
|
|
||||||
|
ocamlc in.sml -o out.out
|
||||||
|
*)
|
||||||
|
|
||||||
|
type info = FI of string * int * int | UNKNOWN
|
||||||
|
type binding = NameBind
|
||||||
|
type context = (string * binding) list
|
||||||
|
|
||||||
|
let rec isnamebound ctx x =
|
||||||
|
match ctx with
|
||||||
|
[] -> false
|
||||||
|
| (y,_)::rest ->
|
||||||
|
if y=x then true
|
||||||
|
else isnamebound rest x
|
||||||
|
|
||||||
|
let rec pickfreshname ctx x =
|
||||||
|
if isnamebound ctx x then pickfreshname ctx (x^"'")
|
||||||
|
else ((x,NameBind)::ctx), x
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* Bare bones definition of [term]
|
||||||
|
|
||||||
|
type term = Var of int (* de-Bruijn index *)
|
||||||
|
| Abs of term
|
||||||
|
| App of term * term
|
||||||
|
|
||||||
|
But we are using some annotations to make debugging easier.
|
||||||
|
|
||||||
|
- info: File position where term was found, so errors can point out where the error occurred.
|
||||||
|
- int: For [Var] nodes. Total length of the context in which the variable is occuring. For a consistency check.
|
||||||
|
- string: For [Abs] nodes. To replace de-Bruijn index with a variable name similar to what was used by user.
|
||||||
|
*)
|
||||||
|
|
||||||
|
type term = Var of info * int * int
|
||||||
|
| Abs of info * term * string
|
||||||
|
| App of info * term * term
|
||||||
|
|
||||||
|
|
||||||
|
(* Recursive function to print terms *)
|
||||||
|
let rec printTerm ctxt t = match t with
|
||||||
|
Abs(inf, trm, strng) ->
|
||||||
|
let (ctx', trm') = pickfreshname ctx x
|
||||||
|
in
|
||||||
|
print_string "(lambda ";
|
||||||
|
(* ... *)
|
||||||
|
| App(inf, t1, t2) ->
|
||||||
|
|
||||||
|
|
||||||
|
(* print_string "Hello world!" *)
|
||||||
|
|
|
@ -0,0 +1,2 @@
|
||||||
|
A = 3
|
||||||
|
A = x
|
|
@ -0,0 +1,61 @@
|
||||||
|
/*
|
||||||
|
$ swipl
|
||||||
|
Welcome to SWI-Prolog (threaded, 64 bits, version 8.2.4)
|
||||||
|
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software.
|
||||||
|
Please run ?- license. for legal details.
|
||||||
|
|
||||||
|
For online help and background, visit https://www.swi-prolog.org
|
||||||
|
For built-in help, use ?- help(Topic). or ?- apropos(Word).
|
||||||
|
|
||||||
|
?- [user].
|
||||||
|
|: nat(0).
|
||||||
|
|: nat(s(N)) :- nat(N).
|
||||||
|
|: ^D% user://1 compiled 0.01 sec, 2 clauses
|
||||||
|
true.
|
||||||
|
|
||||||
|
?- nat(0) -> true; abort.
|
||||||
|
true.
|
||||||
|
|
||||||
|
?- nat(s(s(s(0)))) -> true; abort.
|
||||||
|
true.
|
||||||
|
|
||||||
|
?- not(nat(s(s(z)))) -> true; abort.
|
||||||
|
true.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
plus(X, 0, X).
|
||||||
|
plus(0, X, X).
|
||||||
|
plus(X, Y, Z) :- plus(s(X), y, s(Z)).
|
||||||
|
*/
|
||||||
|
|
||||||
|
/*
|
||||||
|
member(X, [X|_]).
|
||||||
|
member(X, [_|L]) :- member(X, L).
|
||||||
|
|
||||||
|
|
||||||
|
?- member(1,[1,2,3]) -> true; abort.
|
||||||
|
true.
|
||||||
|
|
||||||
|
?- not(member(4,[1,2,3])) -> true; abort.
|
||||||
|
true.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
range(ST,EN,N) :- N>=ST, N=<EN.
|
||||||
|
|
||||||
|
|
||||||
|
?- not(range(1,2,0)) -> true; abort.
|
||||||
|
true.
|
||||||
|
|
||||||
|
?- range(1,2,1) -> true; abort.
|
||||||
|
true.
|
||||||
|
|
||||||
|
?- range(1,2,2) -> true; abort.
|
||||||
|
true.
|
||||||
|
|
||||||
|
?- not(range(1,2,3)) -> true; abort.
|
||||||
|
true.
|
||||||
|
*/
|
|
@ -0,0 +1,124 @@
|
||||||
|
datatype re
|
||||||
|
= Chr of int
|
||||||
|
| Cat of re * re
|
||||||
|
| Alt of re * re
|
||||||
|
| Star of re
|
||||||
|
|
||||||
|
(* accept : re -> int list -> (int list -> bool) -> bool *)
|
||||||
|
(* accept_star : re -> int list -> (int list -> bool) -> bool *)
|
||||||
|
fun accept (Chr c) (x::xs) k
|
||||||
|
= (c=x) andalso (k xs)
|
||||||
|
| accept (Cat (r1,r2)) l k
|
||||||
|
(* = accept r1 l (fn xs => *)
|
||||||
|
(* accept r2 xs (fn ys => k ys)) *)
|
||||||
|
= accept r1 l (fn xs => accept r2 xs k)
|
||||||
|
| accept (Alt (r1,r2)) l k
|
||||||
|
(* = (accept r1 l (fn xs => k xs)) orelse *)
|
||||||
|
(* (accept r2 l (fn xs => k xs)) *)
|
||||||
|
= (accept r1 l k) orelse (accept r2 l k)
|
||||||
|
| accept (Star r1) l k = accept_star r1 l k
|
||||||
|
| accept _ _ _ = false
|
||||||
|
and accept_star r l k
|
||||||
|
= (k l) orelse (accept r l (fn xs => accept_star r xs k))
|
||||||
|
|
||||||
|
(* match : re -> int list -> bool *)
|
||||||
|
fun match r l = accept r l (fn xs => xs=nil)
|
||||||
|
|
||||||
|
datatype kont
|
||||||
|
(* (fn xs => xs=nil) *)
|
||||||
|
= KNil
|
||||||
|
(* (fn xs => accept r2 xs k) *)
|
||||||
|
| KAcc of re * kont
|
||||||
|
(* (fn xs => accept_star r xs k) *)
|
||||||
|
| KStar of re * int list * kont
|
||||||
|
|
||||||
|
(* acceptDef: re -> int list -> kont -> bool *)
|
||||||
|
fun acceptDef (Chr c) (x::xs) k
|
||||||
|
= (c=x) andalso (k xs)
|
||||||
|
| acceptDef (Cat (r1,r2)) l k
|
||||||
|
= acceptDef r l (KAcc (r2, k))
|
||||||
|
| acceptDef (Alt (r1,r2)) l k
|
||||||
|
= (acceptDef r1 l k) orelse (acceptDef r2 l k)
|
||||||
|
| acceptDef (Star r1) l k = accept_starDef r1 l k
|
||||||
|
and apply KNil l = l=nil
|
||||||
|
| apply (KAcc (r,k)) l = acceptDef r l k
|
||||||
|
| apply (KStar (r,ll,k)) l = accept_starDef r ll k
|
||||||
|
and accept_starDef r l k = acceptDef r l KNil
|
||||||
|
|
||||||
|
(* (* datatype kont *) *)
|
||||||
|
(* (* = KNil (* (fn xs => xs=nil) *) *) *)
|
||||||
|
(* (* | Kont of kont (* (fn xs => k xs) *) *) *)
|
||||||
|
(* (* (* (fn xs => accept r2 xs (fn ys => k ys)) *) *) *)
|
||||||
|
(* (* | KNst of re * kont *) *)
|
||||||
|
|
||||||
|
(* val re0 = Cat (Chr 0, Cat (Chr 0, Cat (Chr 1, Chr 1))) *)
|
||||||
|
(* val rv0t = accept re0 [0,0,1,1] (fn xs=>xs=nil) (* true : bool *) *)
|
||||||
|
(* val rv0f = accept re0 [0,0,1] (fn xs=>xs=nil) (* false : bool *) *)
|
||||||
|
|
||||||
|
(* (* match re0 [0,0,1,1]; *) *)
|
||||||
|
(* (* val it = true : bool *) *)
|
||||||
|
(* (* - match re0 [0,0,1]; *) *)
|
||||||
|
(* (* val it = false : bool *) *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(*****************************************************************)
|
||||||
|
|
||||||
|
(* (* walk : int list -> (int list -> bool) -> bool *) *)
|
||||||
|
(* fun walk (0::xs, k) *)
|
||||||
|
(* = walk (xs, fn (1::ys) => k ys *)
|
||||||
|
(* | _ => false) *)
|
||||||
|
(* | walk (xs, k) = k xs *)
|
||||||
|
(* (* Base case: xs == nil *) *)
|
||||||
|
(* (* Father... Is it over..? No king rules forever son.. *) *)
|
||||||
|
|
||||||
|
(* (* go : int list -> bool *) *)
|
||||||
|
(* fun go xs = walk (xs, fn l => l = nil) *)
|
||||||
|
(* (* go [1,2,3]; *) *)
|
||||||
|
(* (* val it = false : bool *) *)
|
||||||
|
(* (* - go [0,0,0,1,1,1]; *) *)
|
||||||
|
(* (* val it = true : bool *) *)
|
||||||
|
|
||||||
|
(* (* *) *)
|
||||||
|
(* (* Function as argument => [fn] usages. *) *)
|
||||||
|
(* (* So there are two of them. *) *)
|
||||||
|
(* (* *) *)
|
||||||
|
|
||||||
|
(* datatype kont *)
|
||||||
|
(* = KId *)
|
||||||
|
(* | KWalk of kont *)
|
||||||
|
|
||||||
|
(* (* apply: kont * int list -> bool *) *)
|
||||||
|
(* fun apply (KId, xs) = xs=nil *)
|
||||||
|
(* | apply (KWalk k, 1::xs) = apply (k, xs) *)
|
||||||
|
(* | apply (KWalk _, _) = false *)
|
||||||
|
|
||||||
|
(* (* walkDef : int list -> kont -> bool *) *)
|
||||||
|
(* fun walkDef (0::xs) k = walkDef xs (KWalk k) *)
|
||||||
|
(* | walkDef xs k = apply (k, xs) *)
|
||||||
|
|
||||||
|
(* fun goDef xs = walkDef xs KId *)
|
||||||
|
(* (* - goDef [0,0,1,1]; *) *)
|
||||||
|
(* (* val it = true : bool *) *)
|
||||||
|
(* (* - goDef [0,0,1]; *) *)
|
||||||
|
(* (* val it = false : bool *) *)
|
||||||
|
|
||||||
|
(* (*********************** Peano arithmetic **************************************) *)
|
||||||
|
|
||||||
|
(* (* apply: int * int list -> bool *) *)
|
||||||
|
(* fun applyP (0, xs) = xs=nil *)
|
||||||
|
(* | applyP (k, 1::xs) = applyP (k-1, xs) *)
|
||||||
|
(* | applyP _ = false *)
|
||||||
|
|
||||||
|
(* (* walkDef : int list -> int -> bool *) *)
|
||||||
|
(* fun walkDefP (0::xs) k = walkDefP xs (k+1) *)
|
||||||
|
(* | walkDefP xs k = applyP (k, xs) *)
|
||||||
|
|
||||||
|
(* fun goDefP xs = walkDefP xs 0 *)
|
||||||
|
(* (* - goDefP [1,1,0]; *) *)
|
||||||
|
(* (* val it = false : bool *) *)
|
||||||
|
(* (* - goDefP [0,0,1,1]; *) *)
|
||||||
|
(* (* val it = true : bool *) *)
|
||||||
|
(* (* - goDefP [0,0,0,1,1,1]; *) *)
|
||||||
|
(* (* val it = true : bool *) *)
|
|
@ -0,0 +1,42 @@
|
||||||
|
(* Attempt to replicate a coq file *)
|
||||||
|
datatype instr
|
||||||
|
= Const of bool
|
||||||
|
| Goto of int
|
||||||
|
|
||||||
|
type prog = instr list
|
||||||
|
|
||||||
|
fun eclosure_aux p idx visited =
|
||||||
|
let
|
||||||
|
val inds = List.tabulate (length p, fn x=>x)
|
||||||
|
val aug = ListPair.zip (inds, p)
|
||||||
|
in
|
||||||
|
case (List.nth (aug, idx)) of
|
||||||
|
(i, x) =>
|
||||||
|
(case x of
|
||||||
|
Const _ => [i]
|
||||||
|
| Goto k =>
|
||||||
|
if List.exists (fn x => x=k) visited then [i]
|
||||||
|
else i :: (eclosure_aux p k (i::visited)))
|
||||||
|
end
|
||||||
|
fun eclosure p idx = eclosure_aux p idx []
|
||||||
|
|
||||||
|
val p1 = [
|
||||||
|
Const true, (* 0 *)
|
||||||
|
Const false, (* 1 *)
|
||||||
|
Goto 4, (* 2 *)
|
||||||
|
Const true, (* 3 *)
|
||||||
|
Goto 1 (* 4 *)
|
||||||
|
]
|
||||||
|
|
||||||
|
val p2 = [
|
||||||
|
Const true, (* 0 *)
|
||||||
|
Const false, (* 1 *)
|
||||||
|
Goto 4, (* 2 *)
|
||||||
|
Const true, (* 3 *)
|
||||||
|
Goto 2 (* 4 *)
|
||||||
|
]
|
||||||
|
|
||||||
|
val v1 = eclosure p1 2
|
||||||
|
(* [2,4,1] : int list *)
|
||||||
|
|
||||||
|
val v2 = eclosure p2 2
|
|
@ -0,0 +1,199 @@
|
||||||
|
structure Re : sig
|
||||||
|
(* Type of regular expressions. Int is used as type for now *)
|
||||||
|
datatype re
|
||||||
|
= Null
|
||||||
|
| Eps
|
||||||
|
| Chr of int
|
||||||
|
| Cat of re * re
|
||||||
|
| Alt of re * re
|
||||||
|
| Star of re
|
||||||
|
(* eqtype re *)
|
||||||
|
|
||||||
|
(* https://github.com/smlnj/smlnj/blob/4fd2ef86aa1341e9c43e118ab675738cd3e77135/system/Basis/Implementation/string.sig#L12 *)
|
||||||
|
val /\ : (re * re) -> re
|
||||||
|
val \/ : (re * re) -> re
|
||||||
|
end = struct
|
||||||
|
datatype re
|
||||||
|
= Null
|
||||||
|
| Eps
|
||||||
|
| Chr of int
|
||||||
|
| Cat of re * re
|
||||||
|
| Alt of re * re
|
||||||
|
| Star of re
|
||||||
|
|
||||||
|
(* Some 'notations' *)
|
||||||
|
fun op /\ (x, y) = Cat (x, y)
|
||||||
|
fun op \/ (x, y) = Alt (x, y)
|
||||||
|
infixr 8 /\
|
||||||
|
infixr 9 \/
|
||||||
|
end
|
||||||
|
|
||||||
|
structure Instr :
|
||||||
|
sig
|
||||||
|
(* Type of instructions of VM *)
|
||||||
|
datatype instr
|
||||||
|
= Char of int
|
||||||
|
| Halt
|
||||||
|
| Fork of int
|
||||||
|
| Jump of int
|
||||||
|
val toString: instr -> string
|
||||||
|
end = struct
|
||||||
|
datatype instr
|
||||||
|
= Char of int
|
||||||
|
| Halt
|
||||||
|
| Fork of int
|
||||||
|
| Jump of int
|
||||||
|
|
||||||
|
fun toString (Char c) = "Char " ^ (Int.toString c)
|
||||||
|
| toString Halt = "Halt"
|
||||||
|
| toString (Fork ind) = "Fork " ^ (Int.toString ind)
|
||||||
|
| toString (Jump ind) = "Jump " ^ (Int.toString ind)
|
||||||
|
end
|
||||||
|
|
||||||
|
structure Prog : sig
|
||||||
|
type prog = Instr.instr list
|
||||||
|
val compile: Re.re -> prog
|
||||||
|
val toString: prog -> string
|
||||||
|
val ecloseOne: int -> prog -> IntListSet.set
|
||||||
|
end = struct
|
||||||
|
open Instr
|
||||||
|
open Re
|
||||||
|
type prog = instr list
|
||||||
|
|
||||||
|
fun compile_aux curr Null = [Halt]
|
||||||
|
| compile_aux curr Eps = []
|
||||||
|
| compile_aux curr (Chr c) = [Char c]
|
||||||
|
| compile_aux curr (Cat (r1,r2)) =
|
||||||
|
let
|
||||||
|
val p1 = compile_aux curr r1
|
||||||
|
val n1 = length p1
|
||||||
|
in
|
||||||
|
p1 @ (compile_aux n1 r2)
|
||||||
|
end
|
||||||
|
| compile_aux curr (Alt (r1,r2)) =
|
||||||
|
let
|
||||||
|
val p1 = compile_aux (curr+1) r1
|
||||||
|
val n1 = length p1
|
||||||
|
val p2 = compile_aux (curr+1+n1+1) r2
|
||||||
|
val n2 = length p2
|
||||||
|
val offset1 = curr+n1+2 (* +2 for jump and next *)
|
||||||
|
val offset2 = curr+n1+2+n2
|
||||||
|
in
|
||||||
|
[Fork offset1] @ p1 @ [Jump offset2] @ p2
|
||||||
|
end
|
||||||
|
| compile_aux curr (Star r) =
|
||||||
|
let
|
||||||
|
val p = compile_aux (curr+1) r
|
||||||
|
val n = length p
|
||||||
|
val offset = curr+1+n+1
|
||||||
|
in
|
||||||
|
[Fork offset] @ p @ [Jump curr]
|
||||||
|
end
|
||||||
|
fun compile r = (compile_aux 0 r) @ [Halt]
|
||||||
|
|
||||||
|
fun toString p =
|
||||||
|
let
|
||||||
|
val inds = List.tabulate (length p, fn x=>Int.toString x)
|
||||||
|
val aug = ListPair.zip (inds, p)
|
||||||
|
in
|
||||||
|
foldl
|
||||||
|
(fn ((ind,i), acc) => acc ^ ind ^ "| " ^ (Instr.toString i) ^ "\n")
|
||||||
|
"" aug
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
fun ecloseOne_aux acc ind prog =
|
||||||
|
if ind >= length prog then IntListSet.empty
|
||||||
|
else if IntListSet.member (acc, ind) then IntListSet.empty
|
||||||
|
else
|
||||||
|
case (List.nth (prog, ind)) of
|
||||||
|
Char _ => IntListSet.singleton ind
|
||||||
|
| Fork k =>
|
||||||
|
let val acc' = IntListSet.add (acc, ind) in
|
||||||
|
IntListSet.union (ecloseOne_aux acc' (ind+1) prog, ecloseOne_aux acc' k prog)
|
||||||
|
end
|
||||||
|
| Jump k =>
|
||||||
|
let val acc' = IntListSet.add (acc, ind) in
|
||||||
|
ecloseOne_aux acc' k prog
|
||||||
|
end
|
||||||
|
| Halt => IntListSet.singleton ind
|
||||||
|
(* ecloseOne: int -> prog -> {int} *)
|
||||||
|
(* Take epsilon-closure of one instruction. *)
|
||||||
|
fun ecloseOne ind prog = ecloseOne_aux IntListSet.empty ind prog
|
||||||
|
end
|
||||||
|
|
||||||
|
open Re
|
||||||
|
open Instr
|
||||||
|
open Prog
|
||||||
|
|
||||||
|
fun getChars_aux ((ind, Char _)::p) = ind::(getChars_aux p)
|
||||||
|
| getChars_aux (_::p) = getChars_aux p
|
||||||
|
| getChars_aux [] = []
|
||||||
|
(* getChars: prog -> [int] *)
|
||||||
|
|
||||||
|
|
||||||
|
fun getChars' p =
|
||||||
|
let
|
||||||
|
val inds = List.tabulate (length p, fn x=>x)
|
||||||
|
val aug = ListPair.zip (inds, p)
|
||||||
|
in
|
||||||
|
getChars_aux aug
|
||||||
|
end
|
||||||
|
|
||||||
|
(* Find location of all [Char] *)
|
||||||
|
fun getChars p =
|
||||||
|
let
|
||||||
|
val chrs = getChars' p
|
||||||
|
val indsc = List.tabulate (length chrs, fn x=>x+1)
|
||||||
|
in
|
||||||
|
ListPair.zip (chrs, indsc)
|
||||||
|
end
|
||||||
|
(* Find location of all [Halt] *)
|
||||||
|
fun getHalts p =
|
||||||
|
let
|
||||||
|
val temp = foldl (fn (x,(acc, ctr)) =>
|
||||||
|
case x of
|
||||||
|
Halt => (ctr::acc, ctr+1)
|
||||||
|
| _ => (acc, ctr+1)
|
||||||
|
) ([],0) p
|
||||||
|
in
|
||||||
|
map (fn x => (x,0)) (#1 temp)
|
||||||
|
end
|
||||||
|
|
||||||
|
fun getTrTb p = (getHalts p) @ (getChars p)
|
||||||
|
|
||||||
|
|
||||||
|
val eg1 = Cat (Chr 1, Chr 2)
|
||||||
|
val eg2 = Star (Chr 1)
|
||||||
|
val eg3 = Star (Star (Chr 1))
|
||||||
|
val eg4 = Cat (Chr 0, Alt (Chr 1, Star (Chr 2)))
|
||||||
|
val eg5 = Alt (Chr 0, Chr 1)
|
||||||
|
|
||||||
|
val prog1 = compile eg1
|
||||||
|
val prog2 = compile eg2
|
||||||
|
val prog3 = compile eg3
|
||||||
|
val prog4 = compile eg4
|
||||||
|
(* 0| Char 0 *)
|
||||||
|
(* 1| Fork 4 *)
|
||||||
|
(* 2| Char 1 *)
|
||||||
|
(* 3| Jump 7 *)
|
||||||
|
(* 4| Fork 7 *)
|
||||||
|
(* 5| Char 2 *)
|
||||||
|
(* 6| Jump 4 *)
|
||||||
|
(* 7| Halt *)
|
||||||
|
|
||||||
|
val prog5 = compile eg5
|
||||||
|
(* 0| Fork 3 *)
|
||||||
|
(* 1| Char 0 *)
|
||||||
|
(* 2| Jump 4 *)
|
||||||
|
(* 3| Char 1 *)
|
||||||
|
(* 4| Halt *)
|
||||||
|
|
||||||
|
(* val chrs4 = getChars prog4 *)
|
||||||
|
(* val halt4 = getHalts prog4 *)
|
||||||
|
val trtb4 = getTrTb prog4
|
||||||
|
(* val trtb4' = map (fn (a,b) => (b,a)) trtb4; *)
|
||||||
|
val charIdxs = getChars' prog4
|
||||||
|
val t1 = ecloseOne x prog4
|
||||||
|
|
||||||
|
(* fun foo ind prog *)
|
|
@ -0,0 +1,24 @@
|
||||||
|
#+TITLE: VHDL
|
||||||
|
From 2021-2022..
|
||||||
|
|
||||||
|
- [[./2b-down-counter]]: 2b down counter
|
||||||
|
- [[./2b-timer]]: 2b timer
|
||||||
|
- [[./2b-up-counter]]: 2b up counter
|
||||||
|
- [[./2b-up-counter-gaisler]]: 2b down counter (Gaisler style)
|
||||||
|
- [[./cla-adder]]: 4b carry-lookahead adder
|
||||||
|
- [[./comparator]]: A comparator
|
||||||
|
- [[./half-adder]]: Half adder
|
||||||
|
- [[./ripple-ca]]: 4b ripple carry adder
|
||||||
|
- [[./mux]]: 2:1 MUX
|
||||||
|
- [[./record_inputs]]: using a record as input type
|
||||||
|
|
||||||
|
#delay
|
||||||
|
#delay2
|
||||||
|
#enum
|
||||||
|
#gcd
|
||||||
|
#merge-dff
|
||||||
|
#port_map-mod
|
||||||
|
#vcd-record
|
||||||
|
#weird-clock
|
||||||
|
#rv
|
||||||
|
#subtractor
|
Loading…
Reference in New Issue