add a bunch of old files

bash/pdfscript.sh

@@ -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

bsv/bMakefile

@@ -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

bsv/hack.bsv

@@ -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

c/malloc-cast.c

@@ -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;
+}

c/void-rv-assign.c

@@ -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();
+              ^~~
+*/

clash/FIR.hs

@@ -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))

clash/ListInput.hs

@@ -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
+-}

clash/ListState.hs

@@ -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
+-}

clash/Mac.hs

@@ -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)]

clash/Nfa.hs.orig

@@ -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

clash/Overflow.hs

@@ -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;
+-}

clash/VecInput.hs

@@ -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

clash/fsm.hs

@@ -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

clash/list-to-vec.hs

@@ -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.
+-}
+  

clash/strict-constr.hs

@@ -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
+
+-}

clash/strict-constrv2.hs

@@ -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

coq/mathcomp/hello-ssreflect.v

@@ -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.
+

coq/mathcomp/hello.v

@@ -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) *)

coq/mathcomp/hello2.v

@@ -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.
+

coq/mathcomp/let-hello.v

@@ -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.

coq/mathcomp/reflect.v

@@ -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.

coq/mathcomp/sumj.v

@@ -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.

coq/matrix-as-list.v

@@ -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.

coq/notations.v

@@ -0,0 +1,11 @@
+Module FooMod.
+  #[local] Notation "⊥" := false.
+
+  Check ⊥.  (* ⊥ : bool *)
+
+End FooMod.
+Disable Notation "+" (all).
+
+Import FooMod.
+Compute ⊥.
+(* Syntax Error: Lexer: Undefined token *)

coq/red-black-tree.v

@@ -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.

coq/reflect-even.v

@@ -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

coq/roman.v

@@ -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 *)
+
+

coq/utlc.v

@@ -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.

haskell/ccc.hs

@@ -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

haskell/cmd-args.hs

@@ -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
+-}

haskell/datatypes-a-la-carte.hs

@@ -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)

haskell/dfa.hs

@@ -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"])

haskell/hello.hs

@@ -0,0 +1,4 @@
+main = do
+    putStrLn "Enter your name: "
+    name <- getLine
+    putStrLn ("Hi " ++ name ++ "! Good day.")

haskell/hlist0.hs

@@ -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
+

haskell/parser-monad.hs

@@ -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)])

haskell/perms.hs

@@ -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)

haskell/sierpinski.hs

@@ -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

haskell/template-haskell/hi.hs

@@ -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
+-}

haskell/template-haskell/staging-restriction/TH.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module TH where
+
+import Language.Haskell.TH
+
+someSplice :: Q [Dec]
+someSplice = [d|y = 0|]

haskell/template-haskell/staging-restriction/THEg.hs

@@ -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)
+
+-- -}
+
+  

haskell/traffic-lights.hs

@@ -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)
+
+  

lua/lua-date.lua

@@ -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",

lua/randlua.lua

@@ -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)

lua/table.lua

@@ -0,0 +1,5 @@
+a = {}
+for i=1,5 do
+  --io.write("Enter element number " .. i)
+  a[i] = io.read()
+end

ocaml/factorial.ml

@@ -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 *)

ocaml/lambda.ml

@@ -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!" *)
+

prolog/bmatrix.pl

@@ -0,0 +1,2 @@
+A = 3
+A = x

prolog/hello.pl

@@ -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.
+*/

sml/defun.sml

@@ -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 *) *)

sml/inf.sml

@@ -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

sml/vec.sml

@@ -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 *)

vhdl/README.org

@@ -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