"module style" chialisp. moves toplevel forms to the top level (instead of enclosed) and allows import to be more intelligent ala es2015. Introduces namespaces.

resources/tests/module/basic_program_import.clsp

@@ -0,0 +1,4 @@
+(include *standard-cl-23*)
+(import qualified programs.p1 as P1)
+
+(export () (list P1.program_hash P1.program))

resources/tests/module/classic_program_import.clsp

@@ -0,0 +1,4 @@
+(include *standard-cl-23*)
+(import qualified programs.classic as P1)
+
+(export () (list P1.program_hash P1.program))

resources/tests/module/handcalc.clinc

@@ -0,0 +1,238 @@
+(import std.map)
+(import std.filtermap)
+(import std.relops)
+(import std.truncate)
+(import std.partition)
+(import std.append)
+(import std.reverse)
+(import onehandcalc)
+
+; ranks are 2-14 with 2 being two, 13 being king, and 14 being ace
+; suits are 1-4 with no particular labelling
+; takes a list of cards (rank . suit) and returns the value of the best poker 
+; hand which can be made with them
+; doesn't work for ten or more cards if there are multiple flushes
+; all sorting is done highest to lowest
+(defun find_flush (suits)
+    (assign
+        ((count1 . suit1)) (group_by_count_clean (atomsort suits))
+        (* suit1 (>= count1 5))
+    )
+)
+
+(defun straight_high_inner (ranks last count)
+    (if (not ranks)
+        (if (logand (= last 2) (= count 4))
+            ; maybe ace to five
+            5
+            0
+        )
+        (if (= last (f ranks))
+            ; skip identical cards
+            (straight_high_inner (r ranks) last count)
+            ; if the partial straight continues
+            (if (= (f ranks) (- last 1))
+                (if (= count 4)
+                    ; found a straight, add 3 to last because next and last are included
+                    (+ last 3)
+                    ; keep looking for a straight with the count going up by one
+                    (straight_high_inner (r ranks) (f ranks) (+ count 1))
+                )
+                ; reset the count
+                (straight_high_inner (r ranks) (f ranks) 1)
+            )
+        )
+    )
+)
+
+; returns the high card of a straight or 0 if there isn't any
+; ranks must be sorted in descending order
+(defun straight_high_extended (ranks)
+    (assign
+        high (straight_high_inner ranks 0 0)
+        (if (= high 5)
+            (* (= (f ranks) 14) 5)
+            high
+        )
+    )
+)
+
+(defun group_by_count_clean (items)
+    (map
+        unflatten_card
+        (atomsort (group_by_count_inner items (f items) 0))
+    )
+)
+
+(defun find_straight_flush_indices (flush_suit straight_flush_high (@ cards ((first_rank . first_suit) . remaining)))
+  (if (not cards)
+        0
+        (assign
+            straight_to_ace_match
+                (logand
+                    (= straight_flush_high 5)
+                    (= first_rank 14)
+                 )
+
+            rank_in_range
+                (logand
+                    (<= first_rank straight_flush_high)
+                    (> first_rank (- straight_flush_high 5))
+                )
+
+            hit
+                (logand
+                    (= first_suit flush_suit)
+                    (logior straight_to_ace_match rank_in_range)
+                )
+
+            (logior (lsh (find_straight_flush_indices flush_suit straight_flush_high remaining) 1) hit)
+        )
+    )
+)
+
+(defun flush_cards_with_index (flush_suit index (@ cards ((first_rank . first_suit))))
+    (if (not cards)
+        0
+        (if (= flush_suit first_suit)
+            (c (flatten_card (c first_rank index)) (flush_cards_with_index flush_suit (+ index 1) (r cards)))
+            (flush_cards_with_index flush_suit (+ index 1) (r cards))
+        )
+    )
+)
+
+(defun find_flush_indices (flush_suit cards)
+    (assign
+        myfiltered (truncate 5 (atomsort (flush_cards_with_index flush_suit 0 cards)))
+        (to_bitfield 0 (reverse (atomsort (map (lambda (x) (logand x 15)) myfiltered))))
+    )
+)
+
+; includes should be in ascending order
+(defun to_bitfield (index includes)
+    (if (not includes)
+        0
+        (if (= index (f includes))
+            (logior 1 (lsh (to_bitfield (+ index 1) (r includes)) 1))
+            (lsh (to_bitfield (+ index 1) includes) 1)
+        )
+    )
+)
+
+(defun find_straight_includes (ranks with_index)
+    (if (all ranks with_index)
+        (if (= (f ranks) (lsh (f with_index) -4))
+            (c (logand 15 (f with_index)) (find_straight_includes (r ranks) (r with_index)))
+            (find_straight_includes ranks (r with_index))
+        )
+        0
+    )
+)
+
+(defun find_straight_indices (my_straight_high cards)
+    (assign
+        with_index (atomsort (ranks_with_indices 0 cards))
+        my_ranks
+            (if (= my_straight_high 5)
+                (list 14 5 4 3 2)
+                (list
+                    my_straight_high
+                    (- my_straight_high 1)
+                    (- my_straight_high 2)
+                    (- my_straight_high 3)
+                    (- my_straight_high 4)
+                )
+            )
+
+        includes (reverse (atomsort (find_straight_includes my_ranks with_index)))
+        (to_bitfield 0 includes)
+    )
+)
+
+(defun ranks_with_indices (index cards)
+    (if (not cards)
+        0
+        (c (flatten_card (c (f (f cards)) index)) (ranks_with_indices (+ index 1) (r cards)))
+    )
+)
+
+(defun find_hand_indices ((@ numbered-cards ((number . card) . rest)))
+    (if numbered-cards
+        (logior (lsh 1 number) (find_hand_indices rest))
+        0
+    )
+)
+
+(defun number_cards (num cards)
+    (if cards
+        (c (c num (f cards)) (number_cards (+ num 1) (r cards)))
+        ()
+    )
+)
+
+;; Sorts the cards by group size according to hand.
+;; Hand has pairs of count and rank.  We pull out cards based on their rank
+;; until each bucket is empty in hand and then give the remaining cards.
+(defun bucket_cards_by_frequency_groups (hand cards)
+    (if hand
+        (assign
+            (hand_freq . want_rank) (f hand)
+
+            (cards_with_rank . cards_without_rank) (partition (lambda ((& want_rank) (num . (rank . suit))) (= rank want_rank)) cards)
+
+            ;; We have the cards with this rank... go to the next wanted rank.
+            (append cards_with_rank (bucket_cards_by_frequency_groups (r hand) cards_without_rank))
+        )
+        cards
+    )
+)
+
+(defun normal_full_house (firstcount secondcount hand cards)
+    (find_hand_indices (truncate 5 (bucket_cards_by_frequency_groups hand (number_cards 0 cards))))
+)
+
+(defun handcalc (cards)
+    (assign-lambda
+        first (lambda (x) (f x))
+        rest (lambda (x) (r x))
+        sorted_ranks (atomsort (map first cards))
+        hand (group_by_count_clean sorted_ranks)
+        ((firstcount . firstrank) (secondcount . secondrank)) hand
+        flush_suit (find_flush (map rest cards))
+        (if ;; Full house
+            (logand (= firstcount 3) (= secondcount 2))
+            (normal_full_house firstcount secondcount hand cards)
+
+            ;; Flush
+            flush_suit
+            (assign-lambda
+                flush_cards (filtermap (lambda ((& flush_suit) (@ thecard (rank . suit))) (if (= suit flush_suit) rank 0)) cards)
+                straight_flush_high (straight_high_extended (atomsort flush_cards))
+                (if straight_flush_high
+                    (find_straight_flush_indices flush_suit straight_flush_high cards)
+                    (if (logior (< firstcount 3) (logand (= firstcount 3) (= secondcount 1)))
+                        (find_flush_indices flush_suit cards)
+                        (find_hand_indices (truncate 5 (bucket_cards_by_frequency_groups hand (number_cards 0 cards))))
+                    )
+                )
+            )
+
+            ;; Else
+            (assign
+                my_straight_high (straight_high_extended sorted_ranks)
+                (if (all
+                        my_straight_high
+                        (logior
+                            (< firstcount 3)
+                            (logand (= firstcount 3) (= secondcount 1))
+                        )
+                    )
+
+                    (find_straight_indices my_straight_high cards)
+
+                    (find_hand_indices (truncate 5 (bucket_cards_by_frequency_groups hand (number_cards 0 cards))))
+                )
+            )
+        )
+    )
+)

resources/tests/module/modtest1.clsp

@@ -0,0 +1,6 @@
+(include *standard-cl-23*)
+(import std.assert exposing assert)
+
+(export (X)
+  (assert (not (= X 13)) X)
+  )

resources/tests/module/modtest1_assign.clsp

@@ -0,0 +1,9 @@
+(include *strict-cl-21*)
+(import std.assert exposing assert)
+
+(export (X)
+  (assign
+    less-than-x (- X 13)
+    (assert less-than-x X)
+    )
+  )

resources/tests/module/modtest1_current_module_type.clsp

@@ -0,0 +1,6 @@
+(include *strict-cl-21*)
+(import std.assert exposing assert)
+
+(deftype T (A B))
+
+(export (X Y) (get_T_A (new_T X Y)))

resources/tests/module/modtest1_lambda.clsp

@@ -0,0 +1,6 @@
+(include *strict-cl-21*)
+(import std.assert exposing assert)
+
+(defun F (X) (lambda ((& X) Y) (assert (not (= X 13)) (+ X Y))))
+
+(export (X Y) (a (F X) (list Y)))

resources/tests/module/modtest1_macro.clsp

@@ -0,0 +1,6 @@
+(include *strict-cl-21*)
+(import std.assert exposing assert)
+
+(defmacro M (X) (c 1 X))
+
+(export (Z) (M Z))

resources/tests/module/modtest1_other_module_type.clsp

@@ -0,0 +1,4 @@
+(include *strict-cl-21*)
+(import qualified test-data.test-type as TD)
+
+(export (X Y) (TD.get_TestType_A (TD.new_TestType X Y 1337)))

resources/tests/module/modtest2.clsp

@@ -0,0 +1,8 @@
+(include *strict-cl-21*)
+(import std.assert exposing assert)
+
+(defun F (X) (assert (- X 1) ()))
+(defun G (X) (assert (= 6 (* X 2)) ()))
+
+(export G)
+(export F)

resources/tests/module/modtest2_lambda.clsp

@@ -0,0 +1,6 @@
+(include *strict-cl-21*)
+(import std.assert exposing assert)
+
+(defun F (X) (lambda ((& X) Y) (assert (not (= X 13)) (list (+ X Y) (* X Y)))))
+
+(export (X Y) (a (F X) (list Y)))

resources/tests/module/modtest_internal.clsp

@@ -0,0 +1,5 @@
+(include *strict-cl-21*)
+
+(import test-data.use_internal exposing use-internal-constant)
+
+(export (X) (use-internal-constant X))