tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

check.tri (2147B)

      1 -- Independent structural oracle, lexical compiler, and tricu arithmetic.
      2 -- Run from repository root with --io --allow-read lib/consumer.
      3 !import "prelude" !Local
      4 !import "io" !Local
      5 !import "consumers.base-source" B
      6 !import "consumers.structural" S
      7 !import "consumers.lexical-worker" L
      8 
      9 path name = append "lib/consumer/" (append name ".scp")
     10 load path initial = do onOk_
     11   source <- readFile path
     12   pure (bindResult (B.compileBaseSource source) (named _ :
     13     ok (S.makeConsumer initial (snd (snd named))) t))
     14 compareSucc oracle worker n = (and?
     15   (equal? (S.runConsumer oracle n) (ok (succ n) t))
     16   (equal? (L.lRunChecked worker n) (S.runConsumer oracle n)))
     17 compareAdd oracle worker left right = (and?
     18   (equal? (S.runConsumer oracle (pair left right)) (ok (add left right) t))
     19   (equal? (L.lRunChecked worker (pair left right))
     20     (S.runConsumer oracle (pair left right))))
     21 checkSucc oracle worker = (foldl and? true
     22   (map (compareSucc oracle worker) [0 1 2 3 4 5 6 7 8 15 16 31 32 63 64 127 128 255 256 511 512 1023 1024 4095]))
     23 small = [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15]
     24 checkAdd oracle worker = (and?
     25   (foldl and? true (map (left : foldl and? true
     26     (map (right : compareAdd oracle worker left right) small)) small))
     27   (foldl and? true [
     28   (compareAdd oracle worker 0 0)
     29   (compareAdd oracle worker 0 4095)
     30   (compareAdd oracle worker 4095 0)
     31   (compareAdd oracle worker 1 1)
     32   (compareAdd oracle worker 1 2)
     33   (compareAdd oracle worker 7 1)
     34   (compareAdd oracle worker 15 16)
     35   (compareAdd oracle worker 31 32)
     36   (compareAdd oracle worker 63 1)
     37   (compareAdd oracle worker 127 256)
     38   (compareAdd oracle worker 255 1)
     39   (compareAdd oracle worker 1023 1)]))
     40 run = do onOk_
     41   succIR <- load (path "succ") t
     42   succWorker <- pure (L.lCompile succIR)
     43   addIR <- load (path "add") (pair false succIR)
     44   addWorker <- pure (L.lCompile (S.makeConsumer (pair false succWorker) (snd addIR)))
     45   pure (ok (and? (checkSucc succIR succWorker)
     46     (checkAdd addIR addWorker)) t)
     47 main = io (onResult_ run
     48   (reason : putStrLn (append "arithmetic-ERROR: " reason))
     49   (passed : putStrLn (matchBool "arithmetic-ok" "arithmetic-DIFF" passed)))
     50 main