├── .gitignore ├── .gitattributes ├── min ├── in.m ├── path.m ├── pipe.m ├── err.m ├── out.m ├── def.m ├── spin.m ├── info.m ├── fact.m ├── debug.m ├── z.m ├── trace.m ├── put.m ├── env.m ├── perf.m ├── clock.m ├── quant.m ├── any.m ├── httpd.m ├── zlib.m ├── Makefile ├── log.m ├── core.m ├── cast.m ├── set.m ├── regex.m ├── box.m ├── call.m ├── dbm.m ├── name.m ├── fail.m ├── packs ├── net.m ├── cocoa.m ├── blas.m ├── i.m ├── task.m ├── key.m ├── time.m ├── common_crypto.m ├── dl.m ├── openssl.m ├── posix.m ├── b.m ├── thread.m ├── hex.m ├── http.m ├── pair.m ├── job.m ├── trap.m ├── hash.m ├── flow.m ├── file.m ├── meta.m ├── main.m ├── spot.m ├── socket.m ├── unicode.m ├── c.m ├── map.m ├── opt.m ├── op.m ├── sqlite.m ├── json.m ├── dynamodb.m ├── tag.m ├── rule.m ├── sys.m ├── r.m ├── mem.m ├── ref.m ├── kind.m ├── n.m ├── packs.m ├── row.m ├── group.m ├── fun.m ├── exp.m ├── term.m ├── seq.m └── rewrite.m /.gitignore: -------------------------------------------------------------------------------- 1 | min1 2 | min2 3 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.m linguist-language=Shell 2 | -------------------------------------------------------------------------------- /min: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/min-lang/min/HEAD/min -------------------------------------------------------------------------------- /in.m: -------------------------------------------------------------------------------- 1 | # file 0, standard input 2 | 3 | main x:Z : S = 0.File.of.File.in 4 | -------------------------------------------------------------------------------- /path.m: -------------------------------------------------------------------------------- 1 | # file path, file name 2 | 3 | # http://man7.org/linux/man-pages/man2/open.2.html 4 | in x:S : File = Sys.callx 5 x.S.mem.Mem.nat 0 0 0 0 0 . File.of 5 | 6 | main x:S : S = x.in.File.in 7 | -------------------------------------------------------------------------------- /pipe.m: -------------------------------------------------------------------------------- 1 | # unix pipeline, process input/output chain 2 | 3 | do _ = 4 | r, w = Pair.map File.of 0.Sys.pipe 5 | | Posix.fork 0 & 6 | File.in_size r 10 . Log 7 | 0 8 | | 9 | File.out w 'foo' 10 | 0 11 | -------------------------------------------------------------------------------- /err.m: -------------------------------------------------------------------------------- 1 | # file 2, standard error 2 | 3 | size x:S n:N = Sys.write 2 x n . Z 4 | 5 | char x:C = (Sys.write0 2 x . Z) 6 | 7 | main x:S = size x !x 8 | 9 | main2 x:S = (main x; char \ ) 10 | 11 | tee x:S : S = (Log x; x) 12 | -------------------------------------------------------------------------------- /out.m: -------------------------------------------------------------------------------- 1 | # file 1, standard output 2 | 3 | https://en.wikipedia.org/wiki/Standard_streams#Standard_output_.28stdout.29 4 | 5 | size x:S n:N = Sys.write 1 x n . Z.main 6 | 7 | char x:C = (Sys.write0 1 x . Z.main) 8 | 9 | main x:S = size x !x 10 | -------------------------------------------------------------------------------- /def.m: -------------------------------------------------------------------------------- 1 | # definition, equality 2 | 3 | # see 4 | Def.do and Def.steps in Step.exp_steps 5 | Def.steps in Type.of_exp_do 6 | $Def in Main.main 7 | 8 | exps = %0 : %Exps 9 | 10 | set x:0 y:0 = _ 11 | 12 | T x:0 : 0 = x # show type, see [T] in Type.of_exp_do 13 | -------------------------------------------------------------------------------- /spin.m: -------------------------------------------------------------------------------- 1 | # concurrency synchronization lock 2 | 3 | https://en.wikipedia.org/wiki/Spinlock 4 | 5 | main x:%!0 = Asm 6 | mov a sp 8 7 | @Spin.main_0 8 | pause # yield 9 | cmp a 0 0 10 | j e Spin.main_0 11 | ret 12 | -------------------------------------------------------------------------------- /info.m: -------------------------------------------------------------------------------- 1 | # file 4, informational output 2 | 3 | size x:S n:N = Sys.write 4 x n . Z 4 | 5 | main0 x:C = (Sys.write0 4 x . Z) 6 | 7 | main1 x:S = size x !x 8 | 9 | main x:S = (main1 x; main0 0a) 10 | 11 | main_space x:S = (main1 x; main0 \ ) 12 | 13 | _time = %0 : %N 14 | 15 | fill x:S s:*Any = main (S.fill x s) 16 | 17 | -------------------------------------------------------------------------------- /fact.m: -------------------------------------------------------------------------------- 1 | # assert, check, test 2 | 3 | https://en.wikipedia.org/wiki/QuickCheck 4 | 5 | exps = %0 : %Exps 6 | 7 | bit = Env.bit 'fact' : B 8 | 9 | do spot:S x:B = (x | Fail.force2 spot $Fun) . Z 10 | 11 | check1 spot,fact:S,B = (bit & Log spot; fact | Fail.force2 spot $Fun) . Z 12 | 13 | check _ = List.do $Fact check1 14 | -------------------------------------------------------------------------------- /debug.m: -------------------------------------------------------------------------------- 1 | # file 6, verbose debugging diagnostic 2 | 3 | size x:S n:N = Sys.write 6 x n . Z 4 | 5 | main0 x:C = (Sys.write0 6 x . Z) 6 | 7 | main1 x:S = size x !x 8 | 9 | main x:S = (main1 x; main0 0a) 10 | 11 | main_space x:S = (main1 x; main0 \ ) 12 | 13 | _time = %0 : %N 14 | 15 | fill x:S s:*Any = main (S.fill x s) 16 | 17 | -------------------------------------------------------------------------------- /z.m: -------------------------------------------------------------------------------- 1 | # zero, void, nil, null, unit 2 | 3 | https://en.wikipedia.org/wiki/Unit_type 4 | https://en.wikipedia.org/wiki/Void_type 5 | 6 | # ignore, skip, pass, no-op 7 | main _:0 = 0 8 | 9 | eq _:Z _:Z : B = 1 10 | 11 | opt _:Z : !Z = Cast.any 1 12 | 13 | must _:!Z = 0 14 | -------------------------------------------------------------------------------- /trace.m: -------------------------------------------------------------------------------- 1 | # file 5, performance time tracing 2 | 3 | size x:S n:N = Sys.write 5 x n . Z 4 | 5 | main0 x:C = (Sys.write0 5 x . Z) 6 | 7 | main1 x:S = size x !x 8 | 9 | main x:S = (main1 x; main0 0a) 10 | 11 | main_space x:S = (main1 x; main0 \ ) 12 | 13 | main_hex x:N = main_space x.Hex.str 14 | 15 | fill x:S s:*Any = main (S.fill x s) 16 | -------------------------------------------------------------------------------- /put.m: -------------------------------------------------------------------------------- 1 | # file 1, standard output, with newline 2 | 3 | main x:S = (Out x; Out.char 0a) 4 | 5 | main2 x:S y:S = (Out x; Out.char \ ; Out y; Out.char 0a) 6 | 7 | # no library call, for debugging Dl or $Pre in Main 8 | pure x:S = (Out.size x x.S.size_pure; Out.char 0a . Z) 9 | 10 | nat_pure x:N = x.N.str_pure.pure 11 | 12 | id x:S : S = (main x; x) 13 | 14 | fill x:S s:*Any = main (S.fill x s) 15 | -------------------------------------------------------------------------------- /env.m: -------------------------------------------------------------------------------- 1 | # environment, context 2 | 3 | http://en.wikipedia.org/wiki/Environment_variable 4 | 5 | lib_getenv = Dl 'getenv' : S? !S 6 | 7 | get name:S : !S = Fun.call1 lib_getenv name 8 | 9 | any name:S : B = Opt.bit name.get 10 | 11 | bit name:S : B = Env name . B.of 12 | 13 | main name:S : S = get name | '0' 14 | 15 | must name:S : S = get name | Fail.fill "$s: missing environment variable '$s'" [$Fun, name] 16 | -------------------------------------------------------------------------------- /perf.m: -------------------------------------------------------------------------------- 1 | # performance, profile, monitor 2 | 3 | https://en.wikipedia.org/wiki/Profiling_(computer_programming) 4 | 5 | names = %0 : %Exps 6 | 7 | call = Env.bit 'perf_call' : B 8 | 9 | tick = Env.bit 'perf_tick' : B 10 | 11 | main _ = 12 | List.do $Perf (_ x,t,n:S,%N,%N = (Trace.main_space x; Trace.main_space (!t).N.str; Trace.main_hex !t; Trace (!n).N.str)) # see Perf.names in Step.exp_steps 13 | 0 14 | -------------------------------------------------------------------------------- /clock.m: -------------------------------------------------------------------------------- 1 | # timer, frequency tick 2 | 3 | https://en.wikipedia.org/wiki/Time_Stamp_Counter 4 | 5 | rdtsc _ : N = Asm 6 | rdtsc # edx:eax 7 | shl d 32 8 | or a d 9 | mov sp 16 a 10 | ret 11 | 12 | lib_clock = Dl 'clock' : Z? N 13 | 14 | last = %0 : %N 15 | 16 | main _ : N = Fun.call0 lib_clock 17 | 18 | tick _ : N = Ref.diff last 0.main / 1000 19 | 20 | sub x:%N = Ref.sub x 0.rdtsc 21 | 22 | add x:%N = Ref.add x 0.rdtsc 23 | -------------------------------------------------------------------------------- /quant.m: -------------------------------------------------------------------------------- 1 | # quantitative analysis 2 | 3 | https://en.wikipedia.org/wiki/Quantitative_analyst 4 | http://economics.sas.upenn.edu/~jesusfv/comparison_languages.pdf A Comparison of Programming Languages in Economics 5 | 6 | black_scholes s:R x:R t:R r:R σ:R : R = 7 | d0 = R.log s/x + (r + σ²/2.)*t 8 | d1 = d0 / σ√t 9 | d2 = d1 - σ√t 10 | s ϕ d1 - (x * R.ℯ^(-r * t)) ϕ d2 11 | Fact (black_scholes 71.95 72. 0.002968 0.0025 0.37 ≈ 0.554387) 12 | -------------------------------------------------------------------------------- /any.m: -------------------------------------------------------------------------------- 1 | # abstract data 2 | 3 | # getconf PAGE_SIZE # 4096 4 | code_vmaddr = 01000 # after 4096 __PAGEZERO 5 | 6 | data_vmaddr = 01000000 # after 16MB __TEXT code 7 | 8 | # See Fun.mold1. 9 | _cast x:0 : 1 = x 10 | cast_fun3x x:0 : 1 ? 2 ? 3 = _cast x 11 | cast_fun3 x:0 : 1 ? 2 ? 3 = _cast x 12 | cast_fun4 x:0 : 1 ? 2 ? 3 ? 4 = _cast x 13 | cast_fun5 x:0 : 1 ? 2 ? 3 ? 4 ? 5 = _cast x 14 | cast_fun6 x:0 : 1 ? 2 ? 3 ? 4 ? 5 ? 6 = _cast x 15 | -------------------------------------------------------------------------------- /httpd.m: -------------------------------------------------------------------------------- 1 | # hypertext transfer protocol daemon, web server 2 | 3 | https://en.wikipedia.org/wiki/Httpd 4 | 5 | do x:File = 6 | S.map_char (S.skip (File.in_size x 1000) 0a) 0d 31 . Put 7 | File.write x "HTTP/1.0 200\.\.hello\." 8 | File.close x 9 | 10 | main port:N = 11 | sock0 = Socket 0 12 | #define SO_REUSEADDR 0x0004 /* allow local address reuse */ 13 | Socket.opt sock0 4 14 | Socket.bind sock0 "localhost" port 15 | Socket.listen sock0 16 | Fun.loop ?(Socket.accept sock0 . File.of . Httpd.do) 17 | # curl -v localhost:8080 18 | -------------------------------------------------------------------------------- /zlib.m: -------------------------------------------------------------------------------- 1 | # compression via gzip 2 | 3 | https://en.wikipedia.org/wiki/Zlib 4 | 5 | uncompress x:S n:N : S = 6 | z = S.new 10240 7 | m = Ref 10240 8 | Fun.call4 'uncompress'.Dl z m x n 9 | z 10 | 11 | _ = Dl.open '/System/Library/Frameworks/Security.framework/Versions/A/Security' : N # contains Zlib.compress 12 | main x:S : S = 13 | y = S.new 1024 14 | m = Ref 1024 15 | Fun.call4 'compress'.Dl y m x x.S.size 16 | 17 | z = S.new 1024 18 | n = Ref 1024 19 | Fun.call4 'uncompress'.Dl z n y m.Ref.get 20 | z 21 | Fact (main 'hello' == 'hello') 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | two: one 2 | /usr/bin/time ./min1 binary `cat packs` 3< main.ma > min2 && [ -s min2 ] && chmod +x min2 && ./min2 fact 3 | [[ `md5 < min1` == `md5 < min2` ]] 4 | 5 | one: 6 | sed 's= *\#.*==' packs.m > packs 7 | /usr/bin/time ./min binary `cat packs` 3< main.ma > min1 && [ -s min1 ] && chmod +x min1 && ./min1 fact 8 | 9 | test: all 10 | ./min1 test 11 | ./min1 cocoa & sleep 1; killall min1 12 | ./min1 httpd & sleep 1; curl localhost:8080; killall min1 13 | 14 | race: all 15 | for x in `seq 1 1000`; do ./min2 fact; done 16 | 17 | clean: 18 | rm -f packs min1 min2 19 | -------------------------------------------------------------------------------- /log.m: -------------------------------------------------------------------------------- 1 | # file 2, standard error, with newline 2 | 3 | main x:S = (Err x; Err.char 0a) 4 | 5 | main2 x:S y:S = (Err x; Err.char \ ; Err y; Err.char 0a) 6 | 7 | main3 x:S y:S z:S = (Err x; Err.char \ ; Err y; Err.char \ ; Err z; Err.char 0a) 8 | 9 | main4 x:S y:S z:S w:S = (Err x; Err.char \ ; Err y; Err.char \ ; Err z; Err.char \ ; Err w; Err.char 0a) 10 | 11 | fill x:S s:*Any = main (S.fill x s) 12 | 13 | id x:S : S = (main x; x) 14 | 15 | # no library call, for debugging Dl or $Pre in Main 16 | pure x:S = (Err.size x x.S.size_pure; Err.char 0a) 17 | 18 | nat_pure x:N = x.N.str_pure.pure 19 | -------------------------------------------------------------------------------- /core.m: -------------------------------------------------------------------------------- 1 | # cpu, multi processor, hyperthread 2 | 3 | https://en.wikipedia.org/wiki/Multi-core_processor 4 | https://en.wikipedia.org/wiki/Hyper-threading 5 | https://en.wikipedia.org/wiki/Fork%E2%80%93join_model 6 | 7 | size _ : N = !Posix.cores 8 | 9 | do _ = 10 | !Posix.cores . N.log 11 | 0 12 | 13 | set_affinity i:N = 14 | thread = Fun.call0 'mach_thread_self'.Dl 15 | Fun.call4 'thread_policy_set'.Dl thread 4 %i 1 16 | 17 | affinity _ : N = 18 | thread = Thread.self 0 19 | get_default = %0 20 | policy = %2 21 | count = %1 22 | Fun.call5 'thread_policy_get'.Dl thread 4 policy count get_default 23 | !policy 24 | -------------------------------------------------------------------------------- /cast.m: -------------------------------------------------------------------------------- 1 | # type cast, coercion 2 | 3 | See Step.is_identity. 4 | 5 | any x:0 : 1 = x 6 | 7 | bit x:0 : B = any x 8 | 9 | nat x:0 : N = any x 10 | 11 | mem x:0 : Mem = any x 12 | 13 | bits_real x:N : R = any x 14 | 15 | real_bits x:R : N = any x 16 | 17 | bit_nat x:B : N = any x 18 | 19 | nat_char x:N : C = any x 20 | 21 | char_nat x:C : N = any x 22 | 23 | str_mem x:S : Mem = any x 24 | 25 | mem_str x:Mem : S = any x 26 | 27 | mem_nat x:Mem : N = any x 28 | 29 | file_nat x:File : N = any x 30 | 31 | nat_file x:N : File = any x 32 | 33 | socket_nat x:Socket : N = any x 34 | 35 | nat_socket x:N : Socket = any x 36 | 37 | opt_nat x:!N : N = any x 38 | -------------------------------------------------------------------------------- /set.m: -------------------------------------------------------------------------------- 1 | # mathematical set 2 | 3 | http://en.wikipedia.org/wiki/Set_%28mathematics%29 4 | 5 | main size:N : 0/Z = Cast.any ((size | 1), Row (size | 1)) 6 | 7 | in eq:0?0?B set:0/Z x:0 : B = 8 | size, mem = Hash.data set # size > 0 by Set 9 | i = S.hash x % size 10 | r = Cast.any (Row.at mem i) 11 | List.in eq r x 12 | Fact (in S.eq ['foo', 'bar'].List.set 'bar') 13 | 14 | add set:0/Z x:0 = 15 | size, mem = Hash.data set # size > 0 by Set 16 | i = S.hash x % size 17 | r = Cast.any (Row.at mem i) 18 | Row.set mem i (Cast.any x,r) 19 | Fact (s = ['foo', 'bar'].List.set; add s 'bar'; in S.eq s 'bar') 20 | -------------------------------------------------------------------------------- /regex.m: -------------------------------------------------------------------------------- 1 | # 2 | https://en.wikipedia.org/wiki/Regular_expression#POSIX_basic_and_extended 3 | 4 | lib_regcomp = Dl 'regcomp' : re:Mem? ex:S? flags:N? N 5 | 6 | lib_regexec = Dl 'regexec' : re:Mem? S? size:N? match:Mem? flags:N? N 7 | 8 | # full text 9 | main ex:S x:S : B = search '^'+ex+'$' x 10 | Fact (main 'fo\+bar' 'foobar') 11 | Fact !(main 'foo' 'foobar') 12 | Fact (main 'foo\d\d' 'foo42') 13 | Fact (main 'foo[0-9][0-9]' 'foo42') 14 | Fact !(main 'foo[0-9][0-9]' 'foob2') 15 | 16 | # search match 17 | search ex:S x:S : B = 18 | re = Mem 32 19 | Fun.call3 lib_regcomp re ex 0100 # REG_ENHANCED 20 | Fun.call5 lib_regexec re x 0 0.Mem.of 0 == 0 21 | Fact (search 'foo' 'foobar') 22 | Fact (search 'fo\+bar' 'foobarqux') 23 | Fact (search 'foo\d\d' 'foo42bar') 24 | -------------------------------------------------------------------------------- /box.m: -------------------------------------------------------------------------------- 1 | # packed data, inlined 2 | 3 | https://en.wikipedia.org/wiki/Struct_(C_programming_language) 4 | 5 | byte : Type ? N = 6 | _, N0? 1 7 | _, N1? 2 8 | _, N2? 4 9 | _, Row s? bytes s # inline, unbox, unpack 10 | ? 8 11 | 12 | bytes s:Types : N = List.map_sum_nat s byte 13 | 14 | exps_of_exp : Exp, Type? Exps = 15 | (_, Tree (_, (_, exps))), (_, Row _)? exps # (Row 32 (3,74) (3,125) (3,25) (3,121)) 16 | exp, type? [(Exp.spot exp, Row_ [(Exp.spot exp, Nat type.Row.rank), exp])] 17 | 18 | exps_of_exps exps:Exps types:Types : Exps = List.map_pair exps types exps_of_exp . List.adds 19 | 20 | of_exps spot:Spot exps:Exps types:Types : Exp = 21 | spot, Tree ((spot, Name 'Box'), ((spot, Nat types.bytes), exps_of_exps exps types)) 22 | 23 | size = 8 # the number of bytes for a 64-bit integer or reference 24 | -------------------------------------------------------------------------------- /call.m: -------------------------------------------------------------------------------- 1 | # call stacks, stack trace 2 | 3 | https://en.wikipedia.org/wiki/Stack_trace 4 | 5 | rows = %0 : %*(N,S) 6 | 7 | row_size = 96 8 | 9 | name_size = row_size - 1 - 8 : N 10 | 11 | add spot:Spot mem:N fun:S call:S = 12 | # todo - string pool, strings of variable length 13 | Trap.bit & Ref.seq_add Call.rows (mem, S.fill '$s:$,$s$,$s' [spot.Spot.str1, fun, call]) 14 | 15 | if mem:N base:0 : B = 16 | n = Mem.base base 0 17 | # todo - print non-call addresses as local variables on stack 18 | mem == n & 19 | Log.main (Mem.str (base + 8).Mem.of) 20 | 1 21 | 22 | main mem:N = 23 | n = !Sys.call_size 24 | N.any (_ i:N : B = if mem (!Sys.call_head + i*Call.row_size)) n . Z 25 | 26 | add_flow_at flow:Flow base,call:N,S = 27 | Flow.nat3 flow base 28 | Flow.str_size_nil flow call name_size 29 | 30 | add_flow flow:Flow = Trap.bit & List.do !rows (add_flow_at flow) 31 | -------------------------------------------------------------------------------- /dbm.m: -------------------------------------------------------------------------------- 1 | # unix simple database 2 | 3 | https://en.wikipedia.org/wiki/Dbm 4 | 5 | lib_open = Dl'dbm_open' : path:S? flags:N? mode:N? N 6 | 7 | lib_close = Dl'dbm_close' : db:N? Z 8 | 9 | lib_fetch = Dl'dbm_fetch' : db:N? key:S? key_size:N? Mem,N 10 | 11 | fetch db:N key:S : S = 12 | s, n = Fun.call3_r2 lib_fetch db key !key 13 | S.of_mem s n 14 | 15 | lib_store = Dl'dbm_store' : db:N? key:0? key_size:1? term:2? term_size:3? mode:N? N 16 | 17 | make path:S : N = Fun.call3 lib_open path 0202 01b0 # 0202=O_CREAT|O_RDWR, 01b0 = 0660 rw_rw_ 18 | 19 | replace db:N key:S term:S : N = Fun.call6 lib_store db key !key term !term 1 # DBM_REPLACE 20 | 21 | close db:N = Fun.call1 lib_close db 22 | 23 | test _ = 24 | db = make '/tmp/min-dbm' # expands to [path].db 25 | replace db 'foo' 'yoo' # invalid argument if not dbm_open with O_RDWR 26 | Fact.do $Fun (fetch db 'foo' == 'yoo') 27 | close db 28 | 0 29 | -------------------------------------------------------------------------------- /name.m: -------------------------------------------------------------------------------- 1 | # identifier, unique string, naming convention 2 | 3 | “Short words are best and the old words when short are best of all.” - Winston Churchill 4 | 5 | http://en.wikipedia.org/wiki/Identifier_(computer_science)#In_computer_languages 6 | https://en.wikipedia.org/wiki/Naming_convention_(programming) 7 | https://en.wikipedia.org/wiki/Nomenclature 8 | 9 | a b c d e term, coefficient, expression 10 | f g h function, operator, routine, hex 11 | i j k key, index, offset 12 | n m l size, length, count 13 | p q o rule, pattern pointer, binding, predicate 14 | s r sequence, string, vector, reference 15 | t u v type, class, time 16 | w x y z variable, parameter 17 | 18 | dot x:S y:S : S = x + '.' + y 19 | 20 | ticks x:S : S = x + '.ticks' 21 | 22 | calls x:S : S = x + '.calls' 23 | 24 | add prefix:S n:%N : S = prefix + n.Ref.tick.N.str 25 | -------------------------------------------------------------------------------- /fail.m: -------------------------------------------------------------------------------- 1 | # fatal exit, abort, exception, error 2 | 3 | http://en.wikipedia.org/wiki/Exception_handling 4 | https://github.com/noether-lang/noether/raw/master/doc/presentations/StrangeLoop2014/handling.pdf How to Make Error Handling Less Error-Prone 5 | 6 | exit_skip = %0 : %B 7 | 8 | exit_nat = %0 : %N 9 | 10 | _exit _ : 0 = Sys.exit 1 11 | 12 | main x:S : 0 = (main0 x; Err.char 0a; _exit 0) 13 | 14 | nil _ : 0 = _exit 0 15 | 16 | main0 x:S = (Err x; Err ': error ') 17 | 18 | main2 x:S y:S : 0 = (main0 x; C.err \ ; Err y; Err.char 0a; _exit 0) 19 | 20 | force2 x:S y:S : 0 = (main0 x; C.err \ ; Err y; Err.char 0a; Sys.exit 1) 21 | 22 | main3 x:S y:S z:S : 0 = (main0 x; C.err \ ; Err y; C.err \ ; Log z; _exit 0) 23 | 24 | main4 x:S y:S z:S w:S : 0 = (main0 x; C.err \ ; Err y; C.err \ ; Err z; C.err \ ; Log w; _exit 0) 25 | 26 | main5 x:S y:S z:S w:S u:S : 0 = (main0 x; C.err \ ; Err y; C.err \ ; Err z; C.err \ ; Err w; C.err \ ; Log u; _exit 0) 27 | 28 | fill x:S s:*Any : 0 = (Log.fill x s; _exit 0) 29 | -------------------------------------------------------------------------------- /packs: -------------------------------------------------------------------------------- 1 | 2 | z 3 | b 4 | c 5 | n 6 | i 7 | r 8 | 9 | 10 | any 11 | hex 12 | mem 13 | unicode 14 | fun 15 | 16 | 17 | opt 18 | pair 19 | ref 20 | row 21 | s 22 | list 23 | seq 24 | box 25 | key 26 | map 27 | hash 28 | set 29 | flow 30 | regex 31 | 32 | 33 | core 34 | spin 35 | clock 36 | 37 | 38 | sys 39 | posix 40 | dl 41 | job 42 | thread 43 | task 44 | time 45 | env 46 | 47 | 48 | cast 49 | fail 50 | fact 51 | trap 52 | call 53 | perf 54 | main 55 | 56 | 57 | path 58 | file 59 | pipe 60 | in 61 | out 62 | put 63 | err 64 | log 65 | info 66 | trace 67 | debug 68 | 69 | 70 | socket 71 | net 72 | openssl 73 | common_crypto 74 | http 75 | httpd 76 | 77 | 78 | json 79 | zlib 80 | blas 81 | dbm 82 | sqlite 83 | cocoa 84 | quant 85 | dynamodb 86 | 87 | 88 | spot 89 | tag 90 | name 91 | op 92 | meta 93 | term 94 | exp 95 | group 96 | rule 97 | rewrite 98 | kind 99 | unify 100 | def 101 | type 102 | step 103 | asm 104 | -------------------------------------------------------------------------------- /net.m: -------------------------------------------------------------------------------- 1 | # network address, ip address, host identification 2 | 3 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/getaddrinfo.3.html 4 | lib_getaddrinfo = Dl 'getaddrinfo' : host:S? service:S? hints:Mem? out:%N? N 5 | 6 | # [[ $(curl -s `./min net dynamodb.us-west-1.amazonaws.com`) = $(curl -s dynamodb.us-west-1.amazonaws.com) ]] 7 | host name:S : N = 8 | hints = Mem 48 9 | Mem.set2 hints+4 2 # ai_family = PF_INET 10 | Mem.set2 hints+8 1 # ai_socktype = SOCK_STREAM 11 | info = Ref 0 12 | Fun.call4 lib_getaddrinfo name 0 hints info 13 | # 32 = addrinfo.ai_addr, 4 = sockaddr.sa_data = sockaddr_in.sin_addr 14 | (Mem.next (Mem.get (Mem.next info.Ref.get.Cast.any 32)).Cast.any 4).Mem.get 15 | 16 | str x:N : S = N.ip x 17 | 18 | # host google.com # google.com has address 216.58.194.174 19 | test _ = (x = "google.com"; Put.fill '$s: ip address of $s = $s' [$Fun, x, Net.str (host x)]) 20 | -------------------------------------------------------------------------------- /cocoa.m: -------------------------------------------------------------------------------- 1 | # cocoa ui in mac os x 2 | 3 | main _ = 4 | dlopen = Dl 'dlopen' 5 | Fun.call1 dlopen '/System/Library/Frameworks/Cocoa.framework/Versions/A/Cocoa' # must load before CoreFoundation or AppKit 6 | msg = Dl 'objc_msgSend' 7 | class = Dl 'objc_getClass' 8 | sel = Dl 'sel_getUid' 9 | app = Fun.call2 msg (Fun.call1 class 'NSApplication') (Fun.call1 sel 'sharedApplication') 10 | Fun.call3 msg app (Fun.call1 sel 'setActivationPolicy:') 1 11 | win = Fun.call2 msg (Fun.call1 class 'NSWindow') (Fun.call1 sel 'alloc') 12 | Fun.call5x 04069_0000_0000_0000 msg.Cast.any win (Fun.call1 sel 'initWithContentRect:styleMask:backing:defer:') 1 2 0 # GRect 13 | title = Fun.call3 msg (Fun.call1 class 'NSString') (Fun.call1 sel 'stringWithUTF8String:') 'hello'.S.mem 14 | Fun.call3 msg win (Fun.call1 sel 'setTitle:') title 15 | Fun.call3 msg win (Fun.call1 sel 'makeKeyAndOrderFront:') 0 16 | Fun.call3 msg app (Fun.call1 sel 'activateIgnoringOtherApps:') 1 17 | Fun.call2 msg app (Fun.call1 sel 'run') # failed if [Dl 'NSApp'], not [app] 18 | # killall -9 min 19 | -------------------------------------------------------------------------------- /blas.m: -------------------------------------------------------------------------------- 1 | # basic linear algebra subprograms 2 | 3 | http://www.netlib.org/blas 4 | 5 | lib = Dl.open 'libblas.dylib' : N 6 | 7 | # https://developer.apple.com/library/mac/documentation/Accelerate/Reference/BLAS_Ref/#//apple_ref/c/func/cblas_dscal 8 | lib_dscal = Dl'cblas_dscal' : size:N? a:R? x:*R? dx:N? Z # I? R? R^? I? Z 9 | 10 | # args - di si d c r8 r9 / a 11 | dscal f:0 a:R x:Mem = Asm # x <- a x 12 | mov b sp 24 13 | mov di 2 # size 14 | mov a sp 16 # a 15 | mov xmm0 a 16 | mov si sp 8 # x 17 | mov d 1 # dx 18 | push bp 19 | mov bp sp 20 | and sp 0ffff_fff0 21 | call b 22 | mov sp bp 23 | pop bp 24 | ret 25 | 26 | main _ = 27 | x = 3,5 . Cast.mem 28 | dscal lib_dscal 2. x 29 | Fact.do $Fun (Mem.hex x 16 == '06000000000000000a00000000000000') 30 | 0 31 | -------------------------------------------------------------------------------- /i.m: -------------------------------------------------------------------------------- 1 | # int, natural number, signed integer 2 | 3 | http://en.wikipedia.org/wiki/Integer 4 | https://en.wikipedia.org/wiki/Signedness 5 | 6 | le x:N y:N : B = Asm 7 | mov a sp 16 8 | cmp a sp 8 9 | mov c 0 10 | set sle c 11 | mov sp 24 c 12 | ret 13 | 14 | le x:I y:N : B = Asm 15 | mov a sp 16 16 | cmp a sp 8 17 | mov c 0 18 | set sl c 19 | mov sp 24 c 20 | ret 21 | 22 | lt x:I y:N : B = Asm 23 | mov a sp 16 24 | cmp a sp 8 25 | mov c 0 26 | set sl c 27 | mov sp 24 c 28 | ret 29 | 30 | gt x:N y:N : B = Asm 31 | mov a sp 16 32 | cmp a sp 8 33 | mov c 0 34 | set sg c 35 | mov sp 24 c 36 | ret 37 | 38 | ge x:N y:N : B = Asm 39 | mov a sp 16 40 | cmp a sp 8 41 | mov c 0 42 | set sge c 43 | mov sp 24 c 44 | ret 45 | 46 | rank x:N : N = 47 | | x <= 07f & 0 48 | | x <= 07fff & 1 49 | | x <= 07fff_ffff & 2 50 | | 3 51 | 52 | Fact (rank 42 == 0) 53 | Fact (rank 0ca == 1) 54 | Fact (rank 0cafe == 2) 55 | Fact (rank 0cafe_babe == 3) 56 | Fact (rank 0cafe_babe_dead_beef == 3) 57 | 58 | max2 = 07fff_ffff 59 | 60 | max3 = 07fff_ffff_ffff_ffff 61 | -------------------------------------------------------------------------------- /task.m: -------------------------------------------------------------------------------- 1 | # user-mode thread, coroutine, fiber 2 | 3 | https://en.wikipedia.org/wiki/Coroutine 4 | https://en.wikipedia.org/wiki/Fiber_(computer_science) 5 | 6 | fun = %0 : %!(Z?Z) 7 | do_raw x:N = Asm # callback with c-calling convention 8 | push b; push bp; push r12; push r13; push r14; push r15 # callee-saved registers (only rbx is needed to be restored here?) 9 | push 0 10 | push di 11 | call Task.do 12 | add sp 16 # pop return and first arg di 13 | pop r15; pop r14; pop r13; pop r12; pop bp; pop b 14 | ret # or, Sys.bsdthread_terminate 0 15 | 16 | do x:N = 17 | Core.set_affinity x # necessary? 18 | Spin fun 19 | f = !fun; f 0 # todo - !fun 0 20 | 0 21 | 22 | test _ = 23 | N.for 4 (Sys.bsdthread_create do_raw) # [do_raw] must use c-calling convention 24 | Posix.usleep 10 25 | fun (? N.log 42) 26 | Posix.usleep 100 27 | # todo - Thread.join 28 | -------------------------------------------------------------------------------- /key.m: -------------------------------------------------------------------------------- 1 | # key row, named product, json, label 2 | 3 | https://en.wikipedia.org/wiki/Record_(computer_science) 4 | https://en.wikipedia.org/wiki/Struct_(C_programming_language) 5 | 6 | get_at exp:Exp types:Types key:S base:N : Types ? N, Type = 7 | (_, Binary (_, Name x) ':' t), _ & x == key? base, t 8 | _, t? get_at exp types key base+8 t 9 | ? Exp.seq_error $Fun 'invalid '+key exp,types 10 | 11 | get exp:Exp key:S : Type ? N, Type = 12 | _, Row t? get_at exp t key 0 t 13 | t? Exp.seq_error $Fun 'not row - '+key [t, exp] 14 | 15 | # todo - key in tail 16 | is : Type ? B = 17 | _, Row ((_, Binary (_, Name _) ':' _), _)? 1 18 | 19 | in x:S : Type ? B = _, Row s? List.any s (in_binary x) 20 | 21 | in_binary x:S : Type ? B = _, Binary (_, Name y) ':' _? x == y 22 | 23 | at base:N x:0 : 1 = Mem.get (x.Mem.of + base) . Cast.any 24 | 25 | _test1 x:(foo:N, bar:S) : N = foo x 26 | _test2 x:(foo:N, bar:S) : S = bar x 27 | _test3 x:(foo:N, bar:S) : N = _test1 x 28 | _test4 x:N,S : N = _test1 x 29 | _test5 x:(foo:N, bar:S) : N = _test4 x 30 | _test6 x:N : foo:N, bar:S = 42, 'car' 31 | 32 | Fact (_test1 42,'car' == 42) 33 | Fact (_test1 (foo=42, bar='car') == 42) 34 | Fact (_test2 42,'car' == 'car') 35 | -------------------------------------------------------------------------------- /time.m: -------------------------------------------------------------------------------- 1 | # calendar, date and time, epoch 2 | 3 | lib_time = Dl 'time' : out:Mem? out:Mem 4 | 5 | lib_strftime = Dl 'strftime' : out:Mem? size:N? format:S? time:Mem? size:N 6 | 7 | lib_gmtime = Dl 'gmtime' : time:Mem? Mem 8 | 9 | now _ : Mem = 10 | out = Mem 8 11 | Fun.call1 lib_time out 12 | out 13 | 14 | gmtime time:Mem : Mem = Fun.call1 lib_gmtime time 15 | 16 | # http://en.wikipedia.org/wiki/ISO_8601 17 | datetime_iso time:Mem : S = 18 | out = S.new 16 19 | Fun.call4 lib_strftime out.S.mem 16 '%Y%m%dT%H%M%SZ' time 20 | out 21 | 22 | date_iso time:Mem : S = 23 | out = S.new 8 24 | Fun.call4 lib_strftime out.S.mem 8 '%Y%m%d' time 25 | out 26 | 27 | datetime _ : S = 0.now.gmtime.datetime_iso 28 | 29 | date _ : S = 0.now.gmtime.date_iso 30 | 31 | # 32 | month = Tag 33 | Jan = January 34 | Feb = February 35 | Mar = March 36 | Apr = April 37 | May = May 38 | Jun = June 39 | Jul = July 40 | Aug = August 41 | Sep = September 42 | Oct = October 43 | Nov = November 44 | Dec = December 45 | 46 | day = Tag 47 | Mon = Monday 48 | Tue = Tuesday 49 | Wed = Wednesday 50 | Thu = Thursday 51 | Fri = Friday 52 | Sat = Saturday 53 | 54 | month_days = Row 31 28 31 30 31 30 31 31 30 31 30 31 55 | -------------------------------------------------------------------------------- /common_crypto.m: -------------------------------------------------------------------------------- 1 | # common crypto in mac os x 2 | 3 | https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/Common%20Crypto.3cc.html 4 | 5 | lib_CCHmac = Dl 'CCHmac' : algo:N? key:Mem? key_size:N? data:Mem? data_size:N? out:Mem? Mem 6 | lib_CC_SHA256 = Dl 'CC_SHA256' : data:Mem? data_size:N? out:Mem? Mem 7 | _CC_SHA256_DIGEST_LENGTH = 32 8 | 9 | hmac_str key:S data:S : Mem = hmac key.S.mem key.S.size data.S.mem !data 10 | # f932 0baf 0249 169e 7385 0cd6 156d ed01 06e2 bb6a d8ca b01b 7bbb ebe6 d106 5317$ 11 | Fact (Mem.hex (hmac_str 'foo' 'bar') 32 == 'f9320baf0249169e73850cd6156ded0106e2bb6ad8cab01b7bbbebe6d1065317') 12 | 13 | hmac_key key:Mem data:S : Mem = hmac key _CC_SHA256_DIGEST_LENGTH data.S.mem !data 14 | 15 | hmac_key_hex key:Mem data:S : S = Mem.hex (hmac_key key data) _CC_SHA256_DIGEST_LENGTH 16 | 17 | hmac key:Mem key_size:N data:Mem data_size:N : Mem = 18 | kCCHmacAlgSHA256 = 2 19 | out = Mem _CC_SHA256_DIGEST_LENGTH 20 | Fun.call6x lib_CCHmac kCCHmacAlgSHA256 key key_size data data_size out 21 | out 22 | 23 | sha256 data:S : Mem = 24 | out = Mem _CC_SHA256_DIGEST_LENGTH 25 | Fun.call3 lib_CC_SHA256 data.S.mem !data out 26 | out 27 | 28 | sha256_hex data:S : S = Mem.hex (sha256 data) _CC_SHA256_DIGEST_LENGTH 29 | -------------------------------------------------------------------------------- /dl.m: -------------------------------------------------------------------------------- 1 | # dynamic linking loader, dynamic library 2 | 3 | https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/dlopen.3.html#//apple_ref/doc/man/3/dlopen 4 | 5 | # http://linux.die.net/man/3/dlopen 6 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/dlopen.3.html 7 | lib_dlopen = Dl 'dlopen' : path:S? mode:N? !0 8 | lib_dlerror = Dl 'dlerror' : Z? S 9 | 10 | sym0 name:S : !(1?2) = Asm 11 | mov di 0 # /ref/dyld/include/dlfcn.h #define RTLD_DEFAULT ((void *) -2) /* Use default search algorithm. */ 12 | sub di 2 # must use RTLD_DEFAULT (not RTLD_NEXT) for 'extern id NSApp' 13 | mov si sp 8 14 | mov a Code_vmend # see @Bind BIND_OPCODE_SET_SEGMENT_AND_OFFSET_ULEB(0x01, 0x00000000) in main.ma 15 | call a 0 16 | mov sp 16 a 17 | ret 18 | 19 | main name:S : 0?1 = 20 | f = sym0 name 21 | f | Fail.main2 $Fun name 22 | Fact (N.between 1 (Dl 'dlopen' . Cast.any) I.max3) # 07fffca5a47f7 23 | 24 | open path:S : N = 25 | lib = Fun.call2 lib_dlopen path 0 26 | lib | (Put (Fun.call0 lib_dlerror); 0) 27 | 28 | path_sym path:S name:S = 29 | open path . Hex.put 30 | Dl name . Mem.put 31 | 0 32 | -------------------------------------------------------------------------------- /openssl.m: -------------------------------------------------------------------------------- 1 | # secure sockets layer 2 | 3 | test _ = 4 | dlopen = Dl 'dlopen' 5 | Dl.open '/usr/lib/libssl.0.9.7.dylib' # loading again with path prefix is ok 6 | Fun.call0 'SSL_load_error_strings'.Dl 7 | Fun.call0 'SSL_library_init'.Dl 8 | context = Fun.call1 'SSL_CTX_new'.Dl (Fun.call0 'SSLv23_client_method'.Dl) # Negotiate highest available SSL/TLS version 9 | bio = Fun.call1 'BIO_new_ssl_connect'.Dl context 10 | Fun.call4 'BIO_ctrl'.Dl bio 100 0 'dynamodb.us-west-1.amazonaws.com:443' 11 | Fun.call4 'BIO_ctrl'.Dl bio 101 0 0 # BIO_C_DO_STATE_MACHINE 12 | Fact.do $Fun (Fun.call2 'ERR_error_string'.Dl (Fun.call0 'ERR_get_error'.Dl) 0 == 'error:00000000:lib(0):func(0):reason(0)') 13 | request = 'GET / HTTP/1.1 14 | Host: dynamodb.us-west-1.amazonaws.com 15 | 16 | ' 17 | Fun.call2 'BIO_puts'.Dl bio request 18 | reply = S.new 1024 19 | Fun.call3 'BIO_read'.Dl bio reply 1024 # healthy: dynamodb.us-west-1.amazonaws.com 20 | 21 | # 22 | HTTP/1.1 200 OK 23 | x-amzn-RequestId: I1N01FEFBLQDBO2FIA8QVKBKJJVV4KQNSO5AEMVJF66Q9ASUAAJG 24 | x-amz-crc32: 1538475103 25 | Content-Length: 42 26 | Date: Sun, 08 May 2016 14:31:49 GMT 27 | 28 | healthy: dynamodb.us-west-1.amazonaws.com 29 | Fact.do $Fun (Regex.search 'healthy: dynamodb.us-west-1.amazonaws.com' reply) 30 | -------------------------------------------------------------------------------- /posix.m: -------------------------------------------------------------------------------- 1 | # portable operating system interface 2 | 3 | https://en.wikipedia.org/wiki/POSIX 4 | 5 | # pid_t fork(void); 6 | lib_fork = Dl 'fork' : Z? pid:N 7 | 8 | # int pipe(int fildes[2]); 9 | lib_pipe = Dl 'pipe' : files:Mem? N 10 | 11 | lib_sysconf = Dl 'sysconf' : name:N? N 12 | 13 | # fork _ : N = Fun.call0 lib_fork 14 | fork _ : N = (!Job.multi; Fun.call0 lib_fork) 15 | 16 | pipe ids:N,N : N = 17 | s = Mem 16 18 | Fun.call1 lib_pipe s . Hex.log 19 | #N.log !(!(s.Any.cast + 32).Any.cast) 20 | 0 21 | 22 | # #define _SC_NPROCESSORS_ONLN 58 23 | cores _ : N = Fun.call1 lib_sysconf 58 24 | 25 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/sleep.3.html 26 | # unsigned int sleep(unsigned int seconds); 27 | sleep seconds:N = Fun.call1 'sleep'.Dl seconds 28 | 29 | # http://linux.die.net/man/3/usleep 1.0.-6 30 | usleep seconds:N = Fun.call1 'usleep'.Dl seconds # [0,1000000] 31 | 32 | # http://linux.die.net/man/2/nanosleep 33 | nanosleep seconds:N = Fun.call1 'nanosleep'.Dl seconds 34 | 35 | sigaction kind:N do:N?Z : N = # [do] must use c-calling convention 36 | #s = do, 0, 0 37 | sa_siginfo = 040 38 | s = do, sa_siginfo, 0 # __sigaction_u, sa_flags, sa_mask 39 | Fun.call3 'sigaction'.Dl kind s 0 40 | 41 | # https://developer.apple.com/library/ios/documentation/System/Conceptual/ManPages_iPhoneOS/man2/wait.2.html 42 | wait _ = Fun.call1 'wait'.Dl 0 43 | -------------------------------------------------------------------------------- /b.m: -------------------------------------------------------------------------------- 1 | # bit, bool, boolean, flag, truth, logic, 0 or 1 2 | 3 | 0 false, f, no, n, null, nil, off, falsehood, contradiction, nay 4 | 1 true, t, yes, y, some, on, truth, tautology, aye 5 | 6 | http://en.wikipedia.org/wiki/Boolean_data_type 7 | 8 | or x:B y:B : B = x | y 9 | 10 | and x:B y:B : B = x & y 11 | 12 | all f:0?B x:B a:0 : B = x & f a 13 | 14 | any f:0?B x:B a:0 : B = f a | x 15 | 16 | str x:B : S = x & '1' | '0' 17 | Fact (0.str == '0') 18 | Fact (1.str == '1') 19 | 20 | of : S? B = 21 | '0'? 0 22 | '1'? 1 23 | x? Fail.fill "$s: bad '$s'" [$Fun, x] 24 | Fact !(of '0') 25 | Fact (of '1') 26 | Fact (Job.err ?Z(of 'foo') == "B.of: bad 'foo'\.") 27 | 28 | put x:B = x.B.str.Put 29 | 30 | log x:B = x.B.str.Log 31 | 32 | eq x:B y:B : B = nat x == nat y 33 | Fact (eq 0 0) 34 | Fact !(eq 0 1) 35 | Fact !(eq 1 0) 36 | Fact !(eq 42.cast 0) 37 | Fact (eq 1 1) 38 | Fact (eq 42.cast 1) 39 | 40 | ne x:B y:B : B = nat x != nat y 41 | Fact !(ne 0 0) 42 | Fact (ne 0 1) 43 | Fact (ne 1 0) 44 | Fact (ne 42.cast 0) 45 | Fact !(ne 1 1) 46 | Fact !(ne 42.cast 1) 47 | 48 | not x:B : B = Asm 49 | cmp sp 8 0 50 | j e B.not0 51 | mov sp 16 0 52 | ret 53 | @B.not0 54 | mov sp 16 1 55 | ret 56 | 57 | # B.or, else N.or is inferred 58 | Fact !(B.or 0 0 0) 59 | Fact (B.or 0 0 1) 60 | Fact (B.or 0 1 !Fail.nil) 61 | Fact (Job.err ?(B.or 0 'foo'.Fail) == "foo: error \.") 62 | 63 | cast x:0 : B = Cast.bit x 64 | 65 | nat x:B : N = Cast.bit_nat (N.ne x.Cast.any 0) 66 | Fact (nat 0 == 0) 67 | Fact (nat 1 == 1) 68 | Fact (nat 42.cast == 1) 69 | -------------------------------------------------------------------------------- /thread.m: -------------------------------------------------------------------------------- 1 | # system-mode parallelism 2 | 3 | https://en.wikipedia.org/wiki/Thread_(computing) 4 | 5 | self _ = Fun.call0 'mach_thread_self'.Dl 6 | 7 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/pthread_exit.3.html#//apple_ref/doc/man/3/pthread_exit 8 | exit _ = Fun.call1 Dl'pthread_exit' 0 9 | 10 | # int pthread_create(pthread_t *thread, const pthread_attr_t *attr, void *(*start_routine)(void *), void *arg) 11 | lib_create = Dl'pthread_create' : %N? Z? N?_? N? Z 12 | 13 | create f:N?_ x:N : N = (!Job.multi; y = %0; Fun.call4 lib_create y 0 f x; !y) 14 | 15 | create0 f:N?_ x:N : N = (Sys.set_di x; f 0) 16 | 17 | join x:N = Fun.call2 Dl'pthread_join' x 0 18 | 19 | lock = %0 : %B 20 | 21 | # todo - pass [n] to the new process without [Sys.di] 22 | test n:N = all (_ x:N = (y = 0.Sys.di; Ref.lock Thread.lock; Put y.N.str; Posix.usleep 100.N.pick; Ref.open Thread.lock)) 23 | 24 | # wait until both threads are ready to execute code so they have the same amount of scheduled time for competiting the same resources 25 | two_ready f:N?_ g:N?_ = 26 | Core.set_affinity 0 27 | ready = %0 28 | x = create ((_ ready:%N f:N?_ _:N = (Core.set_affinity 1; ready 1; f 0; exit 0)) ready f) 1 29 | Spin ready 30 | g 1 31 | join x 32 | 33 | two f:N?_ g:N?_ = 34 | Core.set_affinity 0 35 | x = create ((_ f:N?_ _:N = (Core.set_affinity 1; f 0; exit 0)) f) 1 # REWRITE_FREE_VARS_FUN 36 | g 1 37 | join x 38 | 39 | all f:N?_ = 40 | s = N.map 0.Core.size-1 ((_ f:N?_ i:N : N = create ((_ f:N?_ i:N = (f i; exit 0)) f) i+1) f) # REWRITE_FREE_VARS_FUN 41 | create0 f 0 42 | List.do s join 43 | -------------------------------------------------------------------------------- /hex.m: -------------------------------------------------------------------------------- 1 | # hexadecimal number 2 | 3 | https://en.wikipedia.org/wiki/Hexadecimal 4 | leading with 0 instead of 0x: 0cafe_babe 0dead_beef 5 | 6 | str_rev x:N y:S = x & (S.set y (x % 16 < 10 & x % 16 + \0 | x % 16 - 10 + \a).N.char; str_rev x/16 y+1) | S.set y \0 7 | str x:N : S = (y = S.new 17; str_rev x y; S.rev y) 8 | Fact (str 02a == '42') 9 | Fact (Hex.str 02a == '02a') 10 | # 'cafebabe'.decode('hex'); import binascii; binascii.unhexlify('cafebabe') 11 | Fact (Hex.str 0cafe_babe_dead_beef == '0cafebabedeadbeef') 12 | 13 | # without leading 0 14 | str_rev0 x:N y:S = x & (S.set y (x % 16 < 10 & x % 16 + \0 | x % 16 - 10 + \a).N.char; str_rev0 x/16 y+1) 15 | str0 x:N : S = (y = S.new 17; str_rev0 x y; S.rev y) 16 | Fact (str0 02a == '2a') 17 | 18 | str4 x:N : S = '0' + x.str0.S.div4 19 | Fact (str4 0cafe_babe_dead_beef == '0cafe_babe_dead_beef') 20 | 21 | char x:N : C = (x % 16 < 10 & x % 16 + \0 | x % 16 - 10 + \a).N.char 22 | Fact (char 1 == \1) 23 | Fact (char 10 == \a) 24 | Fact (char 0a == \a) 25 | Fact (char 15 == \f) 26 | Fact (char 0ab == \b) 27 | 28 | # https://en.wikipedia.org/wiki/Nibble 29 | at x:N shift:N : C = N.and (N.shr x shift) 0f . char 30 | 31 | n0_str x:N : S = (y = S.new 2; S.set y (at x 4); S.set y+1 (at x 0); y) 32 | Fact (n0_str 0cafe == 'fe') 33 | 34 | n0_out x:N = x.n0_str.Out 35 | 36 | # char_out x:C = x.n0_str.Out 37 | 38 | out x:N = x.Hex.str.Out 39 | Fact (Job.out ?(Hex.out 0cafebabe) == '0cafebabe') 40 | 41 | out0 x:N = x.str0.Out 42 | 43 | put x:N = x.str.Put 44 | 45 | put0 x:N = x.str0.Put 46 | 47 | line x:N = x.str.Put 48 | 49 | log x:N = x.str.Log 50 | 51 | str_size = 16 + 1 : N # 0ffff_ffff_ffff_ffff 52 | -------------------------------------------------------------------------------- /http.m: -------------------------------------------------------------------------------- 1 | # hypertext transfer protocol 2 | 3 | test _ = 4 | sock = Socket 0 5 | Socket.connect sock 'jigsaw.w3.org' 80 6 | request = S.fill 'GET / HTTP/1.1 7 | Host: jigsaw.w3.org 8 | 9 | ' [] 10 | File.out sock.File.of request 11 | # 12 | HTTP/1.1 200 OK 13 | Content-Type: text/plain 14 | Date: Sun, 08 May 2016 14:39:55 GMT 15 | Server: Google Frontend 16 | Content-Length: 15 17 | 18 | 24.130.149.219 19 | Fact.do $Fun (Regex.search 'HTTP/1.. 200 OK' (File.in_size sock.File.of 1000)) 20 | 0 21 | 22 | # ?chunk_size is broken - http://httpbin.org/range/1024?chunk_size=10 23 | test2 _ = 24 | sock = Socket 0 25 | Socket.connect sock 'jigsaw.w3.org' 80 26 | request = S.fill 'GET /HTTP/ChunkedScript HTTP/1.1 27 | Host: httpbin.org 28 | 29 | ' [] 30 | # request . Log 31 | File.out sock.File.of request 32 | # 2000... 33 | File.in_size sock.File.of 40 . Log 34 | 0 35 | 36 | # https://tools.ietf.org/html/rfc7230#section-4.2 # 4.2. Compression Codings 37 | test3 _ = 38 | sock = Socket 0 39 | Socket.connect sock 'httpbin.org' 80 40 | # curl httpbin.org/deflate 41 | request = S.fill 'GET /deflate HTTP/1.1 42 | Host: httpbin.org 43 | 44 | ' [] 45 | File.out sock.File.of request 46 | b = File.in_size sock.File.of 10000 47 | # {"deflated": true, "headers": {"Host": "httpbin.org"}, "method": "GET", "origin": "108.245.44.219"} 48 | # 49 | { 50 | "deflated": true, 51 | "headers": { 52 | "Host": "httpbin.org" 53 | }, 54 | "method": "GET", 55 | "origin": "24.130.149.219" 56 | } 57 | # fixme - httpbin.org now only accepts https (not http) 58 | #Fact.do $Fun (Regex.search '"deflated": true,' (uncompress (S.drop (S.str b "\!\.\!\.") 4) 1000)) 59 | 0 60 | -------------------------------------------------------------------------------- /pair.m: -------------------------------------------------------------------------------- 1 | # two data, product, cons 2 | 3 | https://en.wikipedia.org/wiki/Product_type 4 | https://en.wikipedia.org/wiki/Cons 5 | 6 | cast x:0 : 1, 2 = Cast.any x 7 | 8 | main x:0 y:1 : 0, 1 = (s = Mem 16; Mem.set s x; Mem.set s+8 y; Cast.any s) 9 | 10 | at0 x,_:0,1 : 0 = x 11 | 12 | at1 _,y:0,1 : 1 = y 13 | 14 | Fact (13,'foo' == 13,'foo') 15 | Fact !(13,'foo' == 13,'bar') 16 | Fact (N.max3,2 == N.max3,2) 17 | 18 | eq0 f:0?0?B y:0 x,_:0,1 : B = f x y 19 | Fact (eq0 N.eq 13 13,'foo') 20 | 21 | eq1 f:1?1?B y:1 _,x:0,1 : B = f x y 22 | Fact (eq1 S.eq 'foo' 13,'foo') 23 | 24 | str_by f:0?S g:1?S x,y:0,1 : S = f x + ',' + g y 25 | #str _f:0?S _g:1?S x,y:0,1 : S = _f x + ',' + _g y # Pair.str in Type.of_exp_do 26 | Fact (str_by R.str N.str 3.14,42 == '3.14,42') 27 | Fact (str 13,42 == '13,42') 28 | Fact (str (3,13),42 == '3,13,42') # (3,13),42 29 | Fact (str 'foo','bar' == 'foo,bar') 30 | Fact (str 42,'foo' == '42,foo') 31 | Fact (str 'foo',42 == 'foo,42') 32 | 33 | str2 x:S y:S : S = x + ',' + y 34 | Fact (str2 '3.14' '42' == '3.14,42') 35 | Fact (str N.max3,'foo' == '18446744073709551615,foo') 36 | 37 | map f:0?1 x,y:0,0 : 1,1 = f x, f y 38 | Fact (map N.tick 13,42 == 14,43) 39 | 40 | map1 f:1?2 x,y:0,1 : 0,2 = x, f y 41 | Fact (map1 N.tick 13,42 == 13,43) 42 | 43 | eq_by eq0:0?0?B eq1:1?1?B x,y:0,1 z,w:0,1 : B = eq0 x z & eq1 y w 44 | Fact (eq_by N.eq S.eq 13,'foo' 13,'foo') 45 | Fact !(eq_by N.eq S.eq 13,'foo' 13,'bar') 46 | Fact (eq_by N.mod2 S.eq 13,'foo' 43,'foo') 47 | Fact (13,'foo' == 13,'foo') 48 | Fact !(13,'foo' == 13,'bar') 49 | 50 | ne_by ne0:0?0?B ne1:1?1?B x,y:0,1 z,w:0,1 : B = ne0 x z | ne1 y w 51 | Fact !(ne_by N.ne S.ne 13,'foo' 13,'foo') 52 | Fact (ne_by N.ne S.ne 13,'foo' 13,'bar') 53 | Fact !(13,'foo' != 13,'foo') 54 | Fact (13,'foo' != 13,'bar') 55 | Fact !(ne_by N.mod2_ne S.ne 13,'foo' 43,'foo') 56 | -------------------------------------------------------------------------------- /job.m: -------------------------------------------------------------------------------- 1 | # unix job, process 2 | 3 | https://en.wikipedia.org/wiki/Process_(computing) 4 | 5 | add x:N : N = x > 0ffff_ffff & x | add x+1 6 | 7 | multi _ = Asm 8 | mov a Data_vmend 9 | add a 8 1 10 | ret 11 | 12 | per i:N = 13 | | Posix.fork 0 & 0 14 | | 15 | i+1 . Core.set_affinity 16 | !Core.affinity . N.log 17 | add 0 18 | !Core.affinity . N.log 19 | Sys.exit 0 20 | 0 21 | 22 | main2 _ = 23 | x = Posix.fork 0 24 | | x & Fail 'a' 25 | | Fail 'b' 26 | 27 | out f:Z?0 : S = 28 | r, w = Pair.map File.of !Sys.pipe 29 | | Posix.fork 0 & 30 | Posix.wait 0 31 | File.in_size r 2048 32 | | 33 | File.dup2 w 1.File.of 34 | f 0 35 | Sys.exit 0 36 | 37 | err f:Z?0 : S = 38 | r, w = Pair.map File.of !Sys.pipe 39 | | Posix.fork 0 & 40 | Posix.wait 0 41 | File.in_size r 2048 42 | | 43 | File.dup2 w 2.File.of 44 | f 0 45 | Sys.exit 1 46 | 47 | do f:Z?Z : S, S = 48 | r1, w1 = Pair.map File.of !Sys.pipe 49 | r2, w2 = Pair.map File.of !Sys.pipe 50 | | Posix.fork 0 & 51 | Posix.wait 0 52 | x = File.in_size r1 2048 53 | y = File.in_size r2 2048 54 | x, y # fixme - wait for child to exit 55 | | 56 | File.dup2 w1 1.File.of 57 | File.dup2 w2 2.File.of 58 | # must write some to w1/w2, or r1/r2 above block 59 | Out ' ' 60 | Err ' ' 61 | f 0 62 | Sys.exit 1 63 | 64 | test _ : S, S = 65 | r1, w1 = Pair.map File.of !Sys.pipe 66 | r2, w2 = Pair.map File.of !Sys.pipe 67 | | Posix.fork 0 & 68 | x = File.in_size r1 2048 69 | y = File.in_size r2 2048 70 | Put x 71 | Put y 72 | x, y 73 | | 74 | File.dup2 w1 1.File.of 75 | File.dup2 w2 2.File.of 76 | Out 'ok' 77 | Sys.exit 0 78 | 79 | all = %0 : %*(Z?_) 80 | -------------------------------------------------------------------------------- /trap.m: -------------------------------------------------------------------------------- 1 | # signal, interrupt, fault 2 | 3 | https://en.wikipedia.org/wiki/Trap_(computing) 4 | 5 | bit_not = Env.bit 'Trap_no' : B 6 | 7 | bit = !bit_not : B 8 | 9 | was_bit = $trap : B 10 | 11 | do_stack sp:N = 12 | # N.for2, not N.for, since Fun.new* takes only 32-bit integers (not 64-bit) 13 | N.for2 50 (_ x:N i:N = Call.main (Mem.base x i*8)) sp # fixme - Call tag vs Call.main 14 | 15 | # void handler(int, siginfo_t *info, ucontext_t *uap); 16 | do kind:N info:N context:N = 17 | # 48 = _STRUCT_MCONTEXT *uc_mcontext 18 | # 9 = 2 = _STRUCT_X86_EXCEPTION_STATE64 __es, 7 = rsp in _STRUCT_X86_THREAD_STATE64 __ss 19 | Log.fill '$s signal $n' [$Fun, kind] 20 | do_stack (Mem.base2 context 48 9*8) 21 | Sys.exit 1 22 | 23 | # void (*__sa_sigaction)(int, struct __siginfo *, void *); 24 | do_raw kind:N = Asm # callback with c-calling convention 25 | push b; push bp; push r12; push r13; push r14; push r15 # callee-saved registers (only rbx is needed to be restored here?) 26 | push 0 27 | push di 28 | push si 29 | push d 30 | call Trap.do 31 | add sp 32 32 | pop r15; pop r14; pop r13; pop r12; pop bp; pop b 33 | ret 34 | 35 | sigsegv = 11 # SIGSEGV - Segmentation fault: 11 36 | 37 | sigusr1 = 30 38 | 39 | main _ = bit & Posix.sigaction sigsegv do_raw . Z 40 | 41 | # 42 | Trap.do signal 11 43 | s.m:103.18: S.size Fun.call1 44 | trap.m:30.19: Trap.f77 S.size 45 | trap.m:30.10: Fact.check Job.err 46 | Fact (bit & Regex "Trap.do signal 11\.s.m:\\d\\+.\\d\\+: S.size Fun.call1\.trap.m:\\d\\+.\\d\\+: Trap.f\\d\\+ S.size\.trap.m:\\d\\+.\\d\\+: Fact.check Job.err\." (Job.err (? S.size 0 . Z))) 47 | 48 | # http://man7.org/linux/man-pages/man2/sigaltstack.2.html stack overflow 49 | over _ = 0.over 50 | 51 | -------------------------------------------------------------------------------- /hash.m: -------------------------------------------------------------------------------- 1 | # hashtable, mutable and unordered map 2 | 3 | https://en.wikipedia.org/wiki/Hash_table 4 | 5 | (0/1) = N, (0,1)^ 6 | 7 | # size > 0 or Hash.set fails 8 | main size:N : 0/1 = Cast.any ((size | 1), Row (size | 1)) 9 | 10 | data s:0/1 : N, Mem = Cast.any s 11 | 12 | size s:0/1 : N = data s . 0 13 | 14 | mem s:0/1 : Mem = data s . 1 15 | 16 | in hash:S/0 x:S : B = 17 | size, mem = data hash 18 | i = S.hash x % size 19 | r = Cast.any (Row.at mem i) 20 | List.any r (Pair.eq0 S.eq x) 21 | Fact (in ['foo',13, 'bar',42].List.hash 'bar') 22 | Fact !(in ['foo',13, 'bar',42].List.hash 'qux') 23 | Fact !(in [].List.hash 'foo') 24 | 25 | pair hash:S/0 x:S : !(S, 0) = 26 | size, mem = data hash 27 | i = S.hash x % size 28 | r = Cast.any (Row.at mem i) 29 | List.get_by r (Pair.eq0 S.eq x) 30 | Fact (pair ['foo',13, 'bar',42].List.hash 'bar' == 'bar',42) 31 | Fact !(pair [].List.hash 'foo' . Opt.bit) 32 | 33 | get hash:S/0 x:S : !0 = 34 | y = pair hash x 35 | y & y.Row.at1 36 | Fact (get ['foo',13, 'bar',42].List.hash 'bar' == 42) 37 | Fact !(get [].List.hash 'foo') 38 | 39 | set hash:S/0 x:S y:0 = 40 | size, mem = data hash 41 | i = S.hash x % size 42 | r = Cast.any (Row.at mem i) 43 | Row.set mem i (Cast.any (x,y),r) 44 | Fact (s = ['foo',13, 'bar',42].List.hash; set s 'bar' 41; get s 'bar' == 41) 45 | Fact (s = [].List.hash; set s 'bar' 41; get s 'bar' == 41) 46 | 47 | get_set hash:S/0 x:S y:0 : B, 0 = 48 | a = get hash x 49 | a & 0, a | (set hash x y; 1, y) 50 | Fact (s = [].List.hash; get_set s 'bar' 41 == 1,41; get_set s 'bar' 42 == 0,41) 51 | 52 | map1 hash:0/1 f:1?2 = 53 | size, mem = data hash 54 | Row.for (Map.map1 f) mem size 55 | Fact (s = ['foo',13, 'bar',42].List.hash; map1 s N.tick; get s 'bar' == 43) 56 | -------------------------------------------------------------------------------- /flow.m: -------------------------------------------------------------------------------- 1 | # stream, buffer, port 2 | 3 | https://en.wikipedia.org/wiki/Stream_(computing) 4 | 5 | Flow = head:S, last:S 6 | 7 | main n:N : Flow = (s = S.new n; s, s) # FIXME check size 8 | 9 | head s:Flow : S = s.0 # inlined 10 | 11 | last s:Flow : S = s.1 # inlined 12 | 13 | add s:Flow n:N = Mem.add s.Mem.of+8 n # inlined 14 | 15 | size s:Flow : N = (s0, s1 = s; s1 - s0) 16 | 17 | char s:Flow x:C = (S.set s.last x; add s 1) 18 | Fact (s = main 1; char s \a; out_str s == 'a') 19 | 20 | mem s:Flow n:N x:Mem = (Mem.copy x s.last.S.mem n; add s n) # racy 21 | 22 | str s:Flow x:S = (S.copy0 x s.last; add s !x) # racy 23 | Fact (s = main 3; str s 'foo'; size s == 3 & out_str s == 'foo') 24 | 25 | str0 s:Flow x:S = (str s x; char s 0) # null terminated, do not assume zero buffer 26 | Fact (s = main 4; str0 s 'foo'; size s == 4 & out_str s == 'foo') 27 | 28 | str_pad s:Flow x:S n:N = (S.copy x s.last; add s n) 29 | Fact (s = main 5; str_pad s 'foo' 5; size s == 5) 30 | 31 | str_size_nil s:Flow x:S n:N = (S.copy_size_nil x s.last n; add s n+1) 32 | Fact (s = main 5; str_size_nil s 'foo' 5; size s == 6) 33 | Fact (s = main 5; str_size_nil s 'foobarqux' 5; size s == 6) 34 | 35 | nat0 s:Flow x:N = char s x.N.char 36 | Fact (s = main 1; nat0 s \a; out_str s == 'a') 37 | 38 | nat1 s:Flow x:N = (nat0 s x; nat0 s (N.shr x 8)) 39 | Fact (s = main 2; nat1 s (N.of1 \a \c); out_str s == 'ca') 40 | 41 | nat2 s:Flow x:N = (nat1 s x; nat1 s (N.shr x 16)) 42 | Fact (s = main 4; nat2 s (N.of2 \e \f \a \c); out_str s == 'cafe') 43 | 44 | nat3 s:Flow x:N = (nat2 s x; nat2 s (N.shr x 32)) 45 | Fact (s = main 8; nat3 s (N.of3 \e \b \a \b \e \f \a \c); out_str s == 'cafebabe') 46 | 47 | nat s:Flow x:N : N?Z = 48 | 0? nat0 s x 49 | 1? nat1 s x 50 | 2? nat2 s x 51 | 3? nat3 s x 52 | Fact (s = main 8; nat s (N.of3 \e \b \a \b \e \f \a \c) 3; out_str s == 'cafebabe') 53 | 54 | out s:Flow = Out.size s.head s.size 55 | 56 | out_str s:Flow : S = S.sub s.head s.size 57 | -------------------------------------------------------------------------------- /file.m: -------------------------------------------------------------------------------- 1 | # unix file description, file number 2 | 3 | https://en.wikipedia.org/wiki/Handle_(computing) 4 | 5 | to x:File : N = Cast.file_nat x 6 | 7 | of x:N : File = Cast.nat_file x 8 | 9 | read file:File x:S size:N : N = Sys.read file.to x size 10 | 11 | in_to file:File x:S : S = read file x 1 & in_to file x+1 | x 12 | 13 | # THREAD_UNSAFE reallocate with the accurate size y-x+1 immediately 14 | in_read file:File : S = (x = Mem 0 . Mem.str; y = in_to file x; S.new y-x; x) 15 | 16 | page_size = 1024 17 | 18 | in_size file:File size:N : S = (x = Mem size . Mem.str; read file x size; x) 19 | 20 | # only for regular file with known size (not socket) 21 | in file:File : S = (n = Sys.fstat file; x = Mem n+1 . Mem.str; m = read file x n; x) # todo - check m 22 | 23 | # no memory allocation due to in_text THREAD_UNSAFE [Mem 0] 24 | in_text_at x:S file:File : S = 25 | n = read file x page_size # check -1 26 | y = x + n 27 | (n == 0 | S.bit x+(n-1)) & in_text_at y file | y # until \0 28 | 29 | # read until \0 30 | in_text file:File : S = 31 | # THREAD_UNSAFE reallocate with the accurate size y-x+1 immediately 32 | x = Mem 0 . Mem.str 33 | y = in_text_at x file 34 | S.new y-x 35 | x 36 | 37 | in_last file:File : S, C = 38 | x = Mem page_size . Mem.str 39 | n = read file x page_size 40 | x, S.char x+(n-1) 41 | 42 | write_size file:File x:S n:N = Sys.write file.to x n . Z 43 | 44 | write file:File x:S = write_size file x !x 45 | 46 | write_char file:File x:C = Sys.write0 file.to x . Z 47 | 48 | write_space file:File x:S = (write file x; write_char file \ ) 49 | 50 | line file:File x:S = (write file x; write_char file 0a) 51 | 52 | out file:File x:S = write file x 53 | 54 | # http://man7.org/linux/man-pages/man2/close.2.html 55 | close x:File = Sys.callx 6 x.to 0 0 0 0 0 . Z 56 | 57 | # http://linux.die.net/man/2/dup2 58 | dup2 old:File new:File : N = Sys.dup2 old.to new.to 59 | -------------------------------------------------------------------------------- /meta.m: -------------------------------------------------------------------------------- 1 | # reflection, string interpolation 2 | 3 | https://en.wikipedia.org/wiki/String_interpolation 4 | http://en.wikipedia.org/wiki/Reflection_%28computer_programming%29 5 | http://en.wikipedia.org/wiki/Homoiconicity 6 | 7 | of_meta nest:N path:S line:N column:N in:S : N, N, S = 8 | S.char in . 9 | 0? Fail.fill '$s:$n:$n: $s missing closing bracket ]' [path, line, column, $Fun] 10 | \[? of_meta nest+1 path line column+1 in+1 11 | \]? nest & of_meta nest-1 path line column+1 in+1 | line, column, in 12 | 0a? of_meta nest+1 path line+1 0 in+1 13 | _? of_meta nest path line column+1 in+1 14 | 15 | of_str path:S line:N column:N in:S : N, N, S = 16 | x = S.char in 17 | | x == 0a & of_str path line+1 0 in+1 18 | 19 | | (x == 0 | x == \[) & line, column, in 20 | 21 | | of_str path line column+1 in+1 22 | 23 | of_path path:S line:N column:N in:S : *Exp = 24 | | in.S.char == \[ & 25 | line2, column2, in2 = of_meta 0 path line column+1 in+1 26 | spot = path, line, column, line2 + 1, column2 + 1 27 | Exp.of2 spot,(S.span in+1 in2), (in2+1 . S.char & of_path path line2 column2+1 in2+1) 28 | | 29 | line2, column2, in2 = of_str path line column+1 in+1 30 | spot = path, line, column, line2, column2 31 | (spot, Str (S.span in in2)), (in2.S.char & of_path path line2 column2 in2) 32 | 33 | of_exp (path,line,column,_),in:Spot,S : *Exp = of_path path line column in 34 | Fact (of_exp $'foo [x]' . Exp.seq_str == "'foo ' x") 35 | Fact (of_exp $'[x] foo' . Exp.seq_str == "x ' foo'") 36 | Fact (of_exp $'foo [x] bar' . Exp.seq_str == "'foo ' x ' bar'") 37 | Fact (of_exp $'foo [x + 40] bar' . Exp.seq_str == "'foo ' (x + 40) ' bar'") 38 | Fact (Regex 'meta.m:\d*:\d*: Exp.str_tree invalid character.*' (Job.err (? of_exp $'foo [x 太] bar' . Z))) # current unit = meta.m 39 | 40 | # Meta [x:N, y:R] 'foo [x] bar [y]' -> List.str0 ['foo ', N.str x, ' bar ', R.str y] 41 | main x=spot,s:Spot,S : Exp = spot, Tree [(spot, Name 'List.str0'), (spot, Listy x.of_exp.Exp.seq_row)] 42 | Fact (main $'foo [x] bar [y]' . str == "(List.str0 ['foo ', x, ' bar ', y])") 43 | -------------------------------------------------------------------------------- /main.m: -------------------------------------------------------------------------------- 1 | # top level, entry point, program start 2 | 3 | path = %'' : %S 4 | 5 | main sp:Mem = 6 | time0 = !Clock.rdtsc 7 | $Def # pack initialization - Type.of_exp_do 8 | !Trap 9 | args = Mem.off sp 8 . Mem.seq 10 | path args.List.opt0 11 | Main.main2 args.List.opt_tail.List.opt_tail (args.List.opt1 | 'missing arg1') 12 | Sys.exit 0 13 | 14 | main2 args:*S : S?Z = 15 | 'fact'? Fact.check 0 16 | 'asm'? Asm.file_steps_binary_out 0.File.of 0 17 | 'asm-file'? Asm.file_steps_binary_out 0.File.of 1 18 | 'term'? 0.In.Exp.str_exps.Exp.seq_spot_basic_put 19 | 'tree'? 0.In.Exp.str_exps.Group.exps_trees.Exp.seq_puts 20 | 'limit'? 0.In.Exp.str_exps.Group.exps_trees.Group.limit_exps.Exp.seq_puts 21 | 'glue'? 0.In.Exp.str_exps.Group.exps_trees.Group.limit_exps.Group.glue_exps.Exp.seq_puts 22 | 'associate'? 0.In.Exp.str_exps.Group.exps_trees.Group.limit_exps.Group.glue_exps.Group.associate_exps.Exp.seq_puts 23 | 'rewrite1'? 0.In.Exp.str_exps.Group.exps_trees.Group.limit_exps.Group.glue_exps.Group.associate_exps.0.Rewrite.do_exp1.Exp.put 24 | 'rewrite'? 0.In.Exp.str_exps.Group.exps_trees.Group.limit_exps.Group.glue_exps.Group.associate_exps.Rewrite.exps.Exp.seq_put 25 | 'step'? 0.In.Exp.str_exps.Group.exps_trees.Group.limit_exps.Group.glue_exps.Group.associate_exps.Rewrite.exps.Step.exps_steps_top.Step.seq_puts 26 | 'kind'? (0.Kind; 0.In.Exp.str_exps.Group.exps_trees.Group.limit_exps.Group.glue_exps.Group.associate_exps.Rewrite.exps.0.Kind.of_type.Exp.put) 27 | 'type'? Type.of_exps_exp args.Exp.paths_exps 0.In.Exp.of . Exp.put 28 | 'binary-in'? 0.File.of.Exp.file_exps.Step.exps_binary_out 29 | 'binary2'? (5.File.of.Exp.file_exps + 0.File.of.Exp.file_exps).Step.exps_binary_out 30 | 'binary'? ((args | Fail 'main2 missing arg2').Exp.unit_exps.Step.exps_binary_out; !Perf) 31 | 'terms'? (args | Fail 'main2 missing arg2').Exp.unit_exps.Group.exps_trees.Exp.seq_spot_basic_put 32 | 'test'? 33 | !Openssl.test 34 | !Dbm.test 35 | Thread.test 4 36 | !Task.test 37 | !Sqlite.test 38 | !Net.test 39 | !Socket.test 40 | !Http.test 41 | !Http.test2 42 | !Dynamodb.test 43 | 'httpd'? Httpd 8080 44 | 'cocoa'? !Cocoa 45 | x? Fail.main2 $Fun x 46 | -------------------------------------------------------------------------------- /spot.m: -------------------------------------------------------------------------------- 1 | # file position, path and line and column 2 | 3 | Spot = path:S, line1:N, column1:N, line2:N, column2:N 4 | 5 | nil = '', 0, 0, 0, 0 : Spot 6 | 7 | line_base = 1 # emacs starts line at 1 8 | 9 | col_base = 1 # emacs starts column at 0 but compilation-mode moves requires +1 10 | 11 | new path:S : Spot = path, line_base, col_base, line_base, col_base 12 | 13 | eq path1,line11,column11,line12,column12:Spot path2,line21,column21,line22,column22:Spot : B = 14 | path1 == path2 & line11 == line21 & column11 == column21 & line12 == line22 & column12 == column22 15 | 16 | end path,_,_,line,column:Spot : Spot = path, line, column, line, column 17 | Fact (eq (end 'foo',2,3,5,8) 'foo',5,8,5,8) 18 | 19 | str path,line1,column1,line2,column2:Spot : S = 20 | # http://www.gnu.org/prep/standards/standards.html#index-formatting-error-messages 21 | # https://github.com/emacs-mirror/emacs/blob/master/etc/compilation.txt 22 | S.fill '$s:$n.$n-$n.$n' [path, line1, column1, line2, column2] 23 | Fact (Spot.str 'foo',2,3,5,8 == 'foo:2.3-5.8') # todo - overload Spot.str in Type 24 | 25 | str1 path,line,column,_:Spot : S = S.fill '$s:$n.$n' [path, line, column] 26 | Fact (str1 'foo',2,3,5,8 == 'foo:2.3') 27 | 28 | path_line path,line,_:Spot : S = S.fill '$s:$n' [path, line] 29 | Fact (path_line 'foo',2,3,5,8 == 'foo:2') 30 | 31 | basic_str x:Spot : S = 32 | _, line1, column1, line2, column2 = x 33 | S.fill '$n.$n-$n.$n' [line1, column1, line2, column2] 34 | Fact (basic_str 'foo',2,3,5,8 == '2.3-5.8') 35 | 36 | fun _,line,_:Spot fun:S : S = S.fill '$s:$n' [fun, line] 37 | Fact (fun 'foo',2,3,5,8 'bar' == 'bar:2') 38 | 39 | spot2 path,line1,column1,_:Spot _,_,_,line2,column2:Spot : Spot = path, line1, column1, line2, column2 40 | Fact (eq (spot2 'foo',2,3,5,8 'bar',13,21,34,55) 'foo',2,3,34,55) 41 | 42 | main x:N : Spot = '__Spot.new', x, x, x, x 43 | 44 | path path,_:Spot : S = path 45 | 46 | unit path,_:Spot : S = S.upper (S.part path '.' | Fail.main2 'spot_unit' path) 47 | Fact (unit 'foo',2,3,5,8 == 'Foo') 48 | 49 | fail2 a:Spot x:S y:S : 0 = Fail.main3 a.str x y 50 | 51 | fail3 a:Spot x:S y:S z:S : 0 = Fail.main4 a.str x y z 52 | 53 | fail4 a:Spot x:S y:S z:S w:S : 0 = Fail.main5 a.str x y z w 54 | -------------------------------------------------------------------------------- /socket.m: -------------------------------------------------------------------------------- 1 | # network file 2 | 3 | Socket = N 4 | 5 | nat x:Socket : N = Cast.socket_nat x 6 | 7 | # http://man7.org/linux/man-pages/man2/socket.2.html 8 | main _ : Socket = Cast.any (Sys.callx 97 2 1 6 0 0 0) # PF_INET/AF_INET SOCK_STREAM IPPROTO_TCP 9 | 10 | inet = 2 # AF_INET - sa_family_t sin_family; 11 | 12 | # size=0, family=inet, port=port, address=(a, b, c, d), pad=0 13 | address0 a:N b:N c:N d:N port:N : Mem = 14 | s = Mem 16 15 | Mem.set0 s 0 # unused - sin_len 16 | Mem.set0 s+1 0 # unused - AF_INET - sa_family_t sin_family; 17 | Mem.net_set1 s+2 port # in_port_t sin_port; 18 | Mem.set0 s+4 a # struct in_addr sin_addr; 19 | Mem.set0 s+5 b 20 | Mem.set0 s+6 c 21 | Mem.set0 s+7 d 22 | s 23 | 24 | address1 ip:N port:N : Mem = 25 | s = Mem 16 26 | Mem.net_set1 s+2 port # in_port_t sin_port; 27 | Mem.set s+4 ip # struct in_addr sin_addr; 28 | s 29 | 30 | address host:S port:N : Mem = address1 host.Net.host port 31 | 32 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man2/connect.2.html 33 | connect1 x:Socket address:Mem = Sys.callx 98 x.nat address.Mem.nat 16 0 0 0 . Z 34 | connect2 x:Socket address:N = Sys.callx 98 x.nat address 16 0 0 0 . Z 35 | connect x:Socket host:S port:N = connect1 x (address host port) 36 | 37 | test _ = 38 | s = main 0 39 | connect s 'google.com' 80 40 | File.out s.File.of "GET / HTTP/1.0\.Host: www.google.com\.\." 41 | # 42 | HTTP/1.0 200 OK 43 | Content-Type: text/html; charset=ISO-8859-1 44 | Fact.do $Fun (Regex.search 'HTTP/1.. 200 OK' (File.in_read s.File.of)) 45 | 46 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man2/setsockopt.2.html 47 | #define SOL_SOCKET 0xffff /* options for socket level */ 48 | opt x:Socket mask:N = Sys.callx 105 x.nat 0ffff mask (Ref 1).Ref.mem.Mem.nat 8 0 . Z 49 | 50 | # http://man7.org/linux/man-pages/man2/bind.2.html 51 | bind1 x:Socket address:Mem = Sys.callx 104 x.nat address.Mem.nat 16 0 0 0 . Z 52 | bind x:Socket host:S port:N = bind1 x (address host port) 53 | 54 | # http://man7.org/linux/man-pages/man2/listen.2.html 55 | listen x:Socket = Sys.callx 106 x.nat 0 0 0 0 0 . Z 56 | 57 | # http://man7.org/linux/man-pages/man2/accept.2.html 58 | accept x:Socket : N = Sys.callx 30 x.nat (Mem 16).Mem.nat (Mem 8).Mem.nat 0 0 0 59 | -------------------------------------------------------------------------------- /unicode.m: -------------------------------------------------------------------------------- 1 | # universal character set 2 | 3 | mask = _0011_1111 4 | 5 | of2 a:N b:N : N = N.or (N.shl a 6) b 6 | of3 a:N b:N c:N : N = N.or3 (N.shl a 12) (N.shl b 6) c 7 | of4 a:N b:N c:N d:N : N = N.or4 (N.shl a 24) (N.shl b 12) (N.shl c 6) d 8 | 9 | char2 s:S : C, S = 42, '' 10 | 11 | # 12 | https://en.wikipedia.org/wiki/UTF-8 13 | 7 U+0000 U+007F 0xxxxxxx 0000_0000 14 | 11 U+0080 U+07FF 110xxxxx 10xxxxxx 1100_0000 15 | 16 U+0800 U+FFFF 1110xxxx 10xxxxxx 10xxxxxx 1110_0000 16 | 21 U+10000 U+1FFFFF 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx 1111_0000 17 | char s:S : C, S = 18 | x = S.char s 19 | | x < _1100_0000 & x . N.char, s + 1 # hex(0b11000000) = 0xc0 20 | 21 | | x < _1110_0000 & # hex(0b11100000) = 0xe0 22 | y = S.char s+1 23 | of2 (N.and x _0001_1111) (N.and y mask) . N.char, s + 2 24 | 25 | # https://en.wikipedia.org/wiki/Plane_(Unicode)#Basic_Multilingual_Plane 26 | | x < _1111_0000 & # hex(0b11110000) = 0xf0 27 | y = S.char s+1 28 | z = y & S.char s+2 29 | of3 (N.and x _0000_1111) (N.and y mask) (N.and z mask) . N.char, s + 3 30 | 31 | # https://en.wikipedia.org/wiki/Plane_(Unicode)#Supplementary_Multilingual_Plane 32 | | 33 | y = S.char s+1 34 | z = y & S.char s+2 35 | w = z & S.char s+3 36 | of4 (N.and x _0000_0111) (N.and y mask) (N.and z mask) (N.and w mask) . N.char, s + 4 37 | 38 | Fact (s = 'foo'; char s == \f,s+1) 39 | 40 | # u'\xbc\xbd'.encode('utf8') = '\xc2\xbc\xc2\xbd' 41 | # '太極'.encode('utf8') = '\xc2\xbc\xc2\xbd' 42 | # hex(((0xc2 & 0b00011111) << 6) + (0xbc & 0b00111111)) = 0xbc 43 | Fact (s = "\c2\bc\c2\bd"; char s == 0bc,s+2) 44 | 45 | # u'太極' = u'\u592a\u6975' 46 | # u'太極'.encode('utf8') = '\xe5\xa4\xaa\xe6\xa5\xb5' 47 | Fact (s = "\e5\a4\aa\e6\a5\b5"; char s == 0592a,s+3) 48 | 49 | # https://en.wikipedia.org/wiki/Emoticons_(Unicode_block) 😄 50 | # print u'\U0001f604' # smiley face in Terminal 51 | # u'\U0001f604'.encode('utf8') = '\xf0\x9f\x98\x84' 52 | Fact (s = "\f0\9f\98\84"; char s == 01f604,s+4) 53 | 54 | # https://en.wikipedia.org/wiki/Number_Forms vulgar fraction 55 | # ¼ ½ ¾ ⅐ ⅑ ⅒ ⅓ ⅔ ⅕ ⅖ ⅗ ⅘ ⅙ ⅚ ⅛ ⅜ ⅝ ⅞ ↉ 56 | is_op x:C : B = List.in C.eq [\≈] x 57 | 58 | is_name x:C : B = List.in C.eq [\σ, \ϕ, \π, \√, \², \ℯ, \₀, \₁, \₂, \½, \⅓, \¼, \⅕, \⅙, \⅐, \⅛, \⅑, \⅒] x 59 | Fact (is_name \π) 60 | Fact (is_name \²) 61 | Fact (is_name \½) 62 | 63 | # todo 64 | ⅈ ∞ 65 | × ✕ ✖ ÷ 66 | ∘ ∙ ⋅ ⋆ 67 | ∅ ∈ 68 | ∪ ∩ ≤ ≥ ⊂ ⊃ ⊆ ⊇ 69 | ⋀ ⋁ ∫ ⌈ ⌉ ⌊ ⌋ ∀ ∃ ≈ 70 | -------------------------------------------------------------------------------- /c.m: -------------------------------------------------------------------------------- 1 | # char, character, unicode code point 2 | 3 | https://en.wikipedia.org/wiki/Character_(computing) 4 | https://en.wikipedia.org/wiki/Unicode 5 | 6 | add x:C y:N : C = Asm 7 | mov a sp 16 8 | mov c sp 8 9 | add a c 10 | mov sp 24 a 11 | ret 12 | 13 | sub x:C y:N : C = Asm 14 | mov a sp 16 15 | mov c sp 8 16 | sub a c 17 | mov sp 24 a 18 | ret 19 | 20 | Fact (\. == 46) 21 | Fact (\a == 97) 22 | 23 | eq x:C y:C : B = N.eq x y 24 | 25 | ne x:C y:C : B = N.ne x y 26 | 27 | bin x:C : N = x - \0 28 | Fact (bin \0 == 0) 29 | Fact (bin \1 == 1) 30 | 31 | hex x:C : N = between \a x \f & x - \a + 10 | x - \0 32 | Fact (hex \a == 0a) 33 | 34 | hex2 x:C y:C : N = (16 * hex x) + hex y 35 | Fact (hex2 \4 \2 == 042) 36 | 37 | meta : C? C = (\.? 0a; \!? 0d; \'? \"; \"? \'; \\? \\) # printf format 38 | Fact (meta \. == 0a) 39 | Fact (meta \! == 0d) 40 | Fact (meta \' == \") 41 | Fact (meta \" == \') 42 | 43 | code2 : C? S = (09? '\,'; 0a? '\.'; 0d? '\!'; x? str x) 44 | Fact (code2 0a == '\.') 45 | Fact (code2 09 == '\,') 46 | Fact (code2 0d == '\!') 47 | 48 | out x:C = x.str.Out 49 | 50 | put x:C = x.str.Put 51 | 52 | err x:C = x.str.Err 53 | 54 | log x:C = x.str.Log 55 | 56 | str x:C : S = (s = S.new 1; S.set s x; s) 57 | Fact (str \a == 'a') 58 | 59 | str2 x:C y:C : S = (s = S.new 2; S.set s x; S.set s+1 y; s) 60 | Fact (str2 \2 \a == '2a') 61 | 62 | code x:C : S = (r = S.new 2; S.set r \\; S.set r+1 x; r) 63 | Fact (code \a == "\\a") 64 | 65 | between a:C x:C b:C : B = N.between a x b 66 | 67 | is_bin x:C : B = x == \0 | x == \1 68 | Fact (is_bin \0) 69 | Fact (is_bin \1) 70 | Fact !(is_bin \2) 71 | 72 | is_lo_bin x:C : B = x == \0 | x == \1 | x == \_ 73 | Fact (is_lo_bin \_) 74 | Fact (is_lo_bin \0) 75 | Fact (is_lo_bin \1) 76 | Fact !(is_lo_bin \2) 77 | 78 | is_digit x:C : B = between \0 x \9 79 | Fact (is_digit \7) 80 | Fact !(is_digit \a) 81 | 82 | is_dec x:C : B = x == \_ | is_digit x 83 | Fact (is_dec \7) 84 | Fact (is_dec \_) 85 | 86 | is_hex x:C : B = is_dec x | between \a x \f 87 | Fact (is_hex \a) 88 | Fact (is_hex \_) 89 | 90 | upper x:C : C = add x (\A - \a) 91 | Fact (upper \a == \A) 92 | 93 | is_upper x:C : B = between \A x \Z 94 | Fact (is_upper \A) 95 | Fact !(is_upper \a) 96 | 97 | is_lower x:C : B = between \a x \z 98 | Fact (is_lower \a) 99 | Fact !(is_lower \A) 100 | 101 | is_lo_upper x:C : B = x == \_ | is_upper x 102 | 103 | is_lo_lower x:C : B = x == \_ | is_lower x 104 | 105 | is_letter x:C : B = is_upper x | is_lower x 106 | 107 | is_alpha x:C : B = is_dec x | is_letter x 108 | Fact (is_alpha \a) 109 | Fact (is_alpha \_) 110 | 111 | is_name x:C : B = x == \. | is_alpha x 112 | Fact (is_name \A) 113 | Fact (is_name \.) 114 | 115 | is_nil x:C : B = x == 0 116 | 117 | is_any x:C : B = 1 118 | 119 | nat x:C : N = Cast.char_nat x 120 | 121 | max = 010_fffd 122 | 123 | opt x:C : !C = Cast.any (x + 1) 124 | -------------------------------------------------------------------------------- /map.m: -------------------------------------------------------------------------------- 1 | # finite map, association, dictionary 2 | 3 | https://en.wikipedia.org/wiki/Associative_array 4 | 5 | in eq:0?0?B s:*(0,1) x:0 : B = 6 | s & 7 | a, b = s.List.head 8 | | eq a x & 1 9 | # | a == x & 1 10 | | in eq s.List.tail x 11 | Fact (in S.eq ['foo',41, 'bar',42] 'bar') 12 | Fact !(in S.eq ['foo',41, 'bar',42] 'qux') 13 | 14 | get eq:0?0?B s:*(0,1) x:0 : !1 = 15 | | s & 16 | a, b = s.List.head 17 | | eq a x & b 18 | | get eq s.List.tail x 19 | Fact (get S.eq ['foo',41, 'bar',42] 'bar' == 42) 20 | Fact !(get S.eq ['foo',41, 'bar',42] 'qux' . Opt.bit) 21 | 22 | get_by eq:0?0?B s:*(0,1) x:0 : !1 = 23 | | s & 24 | a, b = s.List.head 25 | | eq a x & b 26 | | get_by eq s.List.tail x 27 | Fact (get_by S.eq ['foo',41, 'bar',42] 'bar' == 42) 28 | Fact !(get_by S.eq ['foo',41, 'bar',42] 'qux' . Opt.bit) 29 | 30 | pair eq:0?0?B s:*(0,1) x:0 : !(0, 1) = 31 | | s & 32 | a, b = s.List.head 33 | # | a == x & a, b 34 | | eq a x & a, b 35 | | pair eq s.List.tail x 36 | Fact (pair S.eq ['foo',41, 'bar',42] 'bar' == 'bar',42) 37 | 38 | get_nat str:0?S eq:0?0?B error:S s:*(0,N) x:0 : N = 39 | | s & 40 | a, b = s.List.head 41 | | eq a x & b 42 | | get_nat str eq error s.List.tail x 43 | | Fail.main3 error 'get_nat' x.str 44 | Fact (get_nat S.str S.eq '' ['foo',41, 'bar',0] 'foo' == 41) 45 | Fact (get_nat S.str S.eq '' ['foo',41, 'bar',42] 'bar' == 42) 46 | #Fact (Job.err ?Z(get_nat N.str N.eq 'foo' [2,41, 3,42] N.max3) == "foo: error get_nat 18446744073709551615\.") [make race] Job.err? 47 | #Fact (Job.err ?Z(get_nat 'fum' ['foo',41, 'bar',0] 'qux') == "fum: error get_nat qux\.") # [make race] Job.err? 48 | 49 | str_by f:0?S g:1?S s:*(0,1) : S = List.map_str s (Pair.str_by f g) 50 | Fact (str_by Fun.id R.str ['foo',3.14, 'bar',42.] == 'foo,3.14 bar,42') 51 | Fact (str ['foo',3.14, 'bar',42] == 'foo,3.14,bar,42') # fixme: foo,3.14 bar,42 52 | Fact (str [(2, 3), (5, 8)] == '2,3 5,8') 53 | Fact (str ['foo',41, 'bar',42] == 'foo,41 bar,42') 54 | 55 | map s:*(0,1) f:0?2 g:1?3 : *(2,3) = s & (x, y = s.List.head; (f x, g y), map s.List.tail f g) 56 | Fact (map ['foo',41, 'bar',42] S.dup2 N.tick . str == 'foofoo,42 barbar,43') 57 | 58 | keys_map s:*(0,1) f:0?1?2 : *2 = s & (x, y = s.List.head; f x y, keys_map s.List.tail f) 59 | Fact (keys_map ['foo',41, 'bar',42] (_ x:S y:N : N, S = y, x) . str == '41,foo 42,bar') 60 | 61 | keys s:*(0,1) : *0 = keys_map s (_ x:0 _:1 : 0 = x) 62 | Fact (keys ['foo',41, 'bar',42] == ['foo', 'bar']) 63 | 64 | key_set s:*(0,1) : 0/Z = keys s . List.set 65 | 66 | map_str s:*(0,1) f:0?S g:1?S : S = map s f g . str 67 | Fact (map_str ['foo',41, 'bar',42] S.dup2 N.str == 'foofoo,41 barbar,42') 68 | 69 | map1_rev s:*(0,1) f:1?2 r:*(0,2) : *(0,2) = s & map1_rev s.List.tail f (x, y = s.List.head; (x, f y), r) | r 70 | 71 | map1 f:1?2 s:*(0,1) : *(0,2) = List.rev (map1_rev s f 0) 72 | Fact (map1 N.tick [1,2, 3,4] == [1,3, 3,5]) 73 | Fact (map1 N.tick ['foo',41, 'bar',42] . str == 'foo,42 bar,43') 74 | 75 | map1_alt f:1?2 s:*(0,1) : *(0,2) = map s Fun.id f 76 | Fact (map1_alt N.tick [1,2, 3,4] == [1,3, 3,5]) 77 | 78 | do s:*(0,1) f:0?1?Z = s & (x, y = s.List.head; f x y; do s.List.tail f) 79 | -------------------------------------------------------------------------------- /opt.m: -------------------------------------------------------------------------------- 1 | # optional, nullable, some, pointed 2 | 3 | https://en.wikipedia.org/wiki/Option_type 4 | https://en.wikipedia.org/wiki/Nullable_type 5 | http://en.wikipedia.org/wiki/Pointed_set 6 | 7 | # do not use [Cast.any x] since [Opt.un x:B] != 0 8 | of x:B : !Z = x & 0.N.opt.Cast.any 9 | Fact !((of 0) . bit) 10 | Fact ((of 1) . bit) 11 | 12 | to x:!N : N = Cast.opt_nat x 13 | 14 | one x:!0 : 0 = Cast.any x 15 | 16 | nil _ : !0 = Cast.any 0 17 | 18 | bit x:!0 : B = Cast.any x 19 | Fact !(bit 0) 20 | Fact (bit (N.opt 0)) 21 | Fact (bit (N.opt \a)) 22 | 23 | must x:!0 : 0 = Cast.any x # check 0 is not N 24 | #Fact (must 3.N.opt == 3) # FIXME should be type error 25 | Fact (must 'foo' == 'foo') 26 | 27 | # https://en.wikipedia.org/wiki/Null_coalescing_operator default 28 | or x:!N y:N : N = x & N.must x | y 29 | Fact (or 1.N.opt 7 == 1) 30 | Fact (or 0 7 == 7) 31 | 32 | max x:!N y:N : N = x & N.max x.N.must y | y 33 | Fact (max 4.N.opt 2 == 4) 34 | Fact (max 4.N.opt 7 == 7) 35 | Fact (max 0 7 == 7) 36 | 37 | min x:!N y:N : N = x & N.min x.N.must y | y 38 | Fact (min 4.N.opt 2 == 2) 39 | Fact (min 4.N.opt 7 == 4) 40 | Fact (min 0 7 == 7) 41 | 42 | out x:!S = Out (x | '!!') 43 | 44 | line x:S = (out x; Out.char 0a . Z) 45 | 46 | map2 must:!0?0 x:!0 f:0?1?1 y:1 : 1 = x & f x.must y | y 47 | Fact (map2 N.must 0 N.add 5 == 5) 48 | Fact (map2 N.must 3.N.opt N.add 5 == 8) 49 | 50 | do x:!0 f:0?1 : B = x & f x 51 | 52 | map x:!0 f:0?1 : !1 = x & f x 53 | Fact (map 0 (_ x:N : N = x + 3) == 0) 54 | Fact (map 7.N.opt (_ x:N : N = x + 3) == 10.N.opt) 55 | 56 | main0 x:!0 : 0 = x | Fail '0' 57 | 58 | get_nat x:!N error:S : N = x & N.must x | Fail error 59 | 60 | get x:!0 error:S : 0 = x | Fail error 61 | 62 | seq x:!0 : *0 = x & [x] 63 | Fact (seq 0 == 0) 64 | Fact (List.all2 (seq 0.N.opt) [0.N.opt] N.eq) 65 | 66 | # support only ptr - fixme - proper encoding for opt to support both nat/pointer 67 | add x:!0 s:*0 : *0 = x & x,s | s 68 | Fact (List.all2 (add 0 [42]) [42] N.eq) 69 | Fact (List.all2 (add 13 [42]) [13, 42] N.eq) 70 | Fact (List.all2 (add 0 ['bar']) ['bar'] S.eq) 71 | Fact (List.all2 (add 'foo' ['bar']) ['foo', 'bar'] S.eq) 72 | 73 | bit x:!0 : B = Cast.any x 74 | Fact (bit 'foo') 75 | Fact !(bit 0) 76 | 77 | at0 x:!(0,1) : !0 = x & x.0 78 | Fact (at0 0 == 0) 79 | Fact (at0 13,42 == 13) 80 | 81 | eq_by eq:0?0?B x:!0 y:!0 : B = (!x.bit & !y.bit) | (x & y & eq x.one y.one) 82 | Fact (eq_by N.eq 42 42) 83 | Fact !(eq_by N.eq 42 0) 84 | Fact !(eq_by N.eq 13 42) 85 | Fact !(eq_by S.eq 'foo' 0) 86 | Fact (eq_by (Pair.eq_by S.eq N.eq) 'foo',13 'foo',13) 87 | Fact (eq_by (Pair.eq_by N.eq S.eq) 13,'foo' 13,'foo') 88 | Fact !(eq_by (Pair.eq_by N.eq S.eq) 13,'foo' 42,'bar') 89 | 90 | eq0 x:!Z y:!Z : B = N.eq x.Cast.any y.Cast.any 91 | 92 | any x:0 : !0 = Cast.any x 93 | 94 | str_by0 f:0?S x:!0 : S = x & f x | '0' 95 | Fact (str_by0 N.str 0 == '0') 96 | 97 | str_by must:!0?0 f:0?S x:!0 : S = x & f x.must | '0' 98 | Fact (str_by N.must N.str 0 == '0') 99 | Fact (str_by N.must N.str 1.N.opt == '1') 100 | Fact (str_by N.must N.str 1.C.opt == '1') 101 | Fact (str 'foo':!S == 'foo') 102 | Fact (str 'foo'.any == 'foo') 103 | Fact (str 1.N.opt == '1') 104 | Fact (str 1.C.opt == "\01") 105 | -------------------------------------------------------------------------------- /op.m: -------------------------------------------------------------------------------- 1 | # symbolic operator, prefix/infix/suffix function 2 | 3 | ! + - * / % ^ bang add neg/sub mul div mod pow 4 | < > == != <= >= lt gt eq ne le ge 5 | : ~ $ @ type sim meta at 6 | | & or and 7 | , ; [] row step list 8 | '' "" `` str quote re 9 | 10 | 11 | rank : S?N = 12 | ';'? 1 # command step, statement, instruction sequence 13 | 14 | '='? 2 # definition, equation 15 | ':'? 3 # type annotation 16 | 17 | '@'? 5 # at, scope, where 18 | 19 | '?'? 6 # function, map, domain/codomain 20 | '$'? 7 # meta, evaluation 21 | '*'? 8 # linked list 22 | 23 | '|'? 9 # or 24 | '&'? 10 # and 25 | ','? 11 # binary pair, tuple, list separator 26 | '~'? 12 # tree type 27 | 28 | '≈'? 14 # close, similar 29 | '=='? 14 # equal to 30 | '!='? 14 # not equal to 31 | '<'? 14 # less than 32 | '<='? 14 # less than or equal to 33 | '>'? 14 # great than 34 | '>='? 14 # great than or equal to 35 | 36 | '+'? 20 # add 37 | '-'? 20 # subtract 38 | '/'? 21 # div, module token, tokenize 39 | '%'? 21 # ref, modulus, filter, membership 40 | 41 | '!'? 30 # nil/not/empty, fun neg, ref get, size 42 | '^'? 31 # power, exponential, reverse, transpose 43 | '.'? 32 # member, reverse apply 44 | 45 | right name:S : B = List.in S.eq [';', ',', '?'] name 46 | 47 | name_unary : S ? !S = 48 | '!'? 'N.not' 49 | '-'? 'N.neg' 50 | '%'? 'Ref.main' 51 | 52 | name : S ? !S = 53 | '+'? 'add' 54 | '-'? 'sub' 55 | '*'? 'mul' 56 | '/'? 'div' 57 | '%'? 'mod' 58 | '^'? 'pow' 59 | '=='? 'eq' 60 | '!='? 'ne' 61 | '<'? 'lt' 62 | '<='? 'le' 63 | '>'? 'gt' 64 | '>='? 'ge' 65 | ','? 'row' 66 | '≈'? 'sim' 67 | -------------------------------------------------------------------------------- /sqlite.m: -------------------------------------------------------------------------------- 1 | # sql database engine 2 | 3 | https://www.sqlite.org/capi3ref.html 4 | 5 | lib = Dl.open 'libsqlite3.dylib' : N 6 | 7 | lib_open = Dl'sqlite3_open' : path:!S? db:%N? flag:N 8 | 9 | # https://www.sqlite.org/capi3ref.html#sqlite3_exec 10 | lib_exec = Dl'sqlite3_exec' : db:N? sql:S? callback:0? arg:0? error:%S? flag:N 11 | 12 | # const char *sqlite3_errmsg(sqlite3*); 13 | lib_errmsg = Dl'sqlite3_errmsg' : db:N? error:S 14 | 15 | do_raw x:N y:N z:N w:N : N = Asm # callback with c-calling convention 16 | push b; push bp; push r12; push r13; push r14; push r15 # callee-saved registers (only rbx is needed to be restored here?) 17 | push 0 18 | push di 19 | push si 20 | push d 21 | push c 22 | call Sqlite.do 23 | add sp 32 # pop 4 args 24 | pop a # pop 1 return value 25 | pop r15; pop r14; pop r13; pop r12; pop bp; pop b 26 | ret # or, Sys.bsdthread_terminate 0 27 | 28 | # sqlite3 '' 'select 40+2' 29 | do arg:Mem size:N cols:S^ names:S^ : N = 30 | N.for size (_ i:N = (Log.main2 (Row.get names i) (Row.get cols i))) 31 | 0 32 | 33 | # https://www.sqlite.org/capi3ref.html#sqlite3_prepare 34 | int sqlite3_prepare_v2( 35 | sqlite3 *db, /* Database handle */ 36 | const char *zSql, /* SQL statement, UTF-8 encoded */ 37 | int nByte, /* Maximum length of zSql in bytes. */ 38 | sqlite3_stmt **ppStmt, /* OUT: Statement handle */ 39 | const char **pzTail /* OUT: Pointer to unused portion of zSql */ 40 | ); 41 | lib_prepare = Dl'sqlite3_prepare_v2' : db:N? sql:S? size:N? stmt:%N? tail:N? flag:N 42 | 43 | # https://www.sqlite.org/capi3ref.html#sqlite3_step 44 | int sqlite3_step(sqlite3_stmt*); 45 | lib_step = Dl'sqlite3_step' : stmt:N? flag:N 46 | 47 | # https://www.sqlite.org/capi3ref.html#sqlite3_finalize 48 | int sqlite3_finalize(sqlite3_stmt *pStmt); 49 | lib_finalize = Dl'sqlite3_finalize' : stmt:N? flag:N 50 | 51 | # 52 | sqlite3 main.db 'create table users (id key, name)' 53 | sqlite3 main.db 'create table tasks (id key, user, time, summary)' 54 | # sqlite3 main.db 'drop table tasks' 55 | sqlite3 main.db 'select * from users' 56 | sqlite3 main.db 'select * from tasks' 57 | sqlite3 main.db 'select sql from sqlite_master' 58 | <<< '0|laker' sqlite3 main.db '.import /dev/stdin users' 59 | <<< '1|warrior' sqlite3 main.db '.import /dev/stdin users' 60 | <<< '0|0|0|foo' sqlite3 main.db '.import /dev/stdin tasks' 61 | <<< '1|0|5|bar' sqlite3 main.db '.import /dev/stdin tasks' 62 | <<< '2|1|7|qux' sqlite3 main.db '.import /dev/stdin tasks' 63 | test _ = 64 | db = %0 65 | Fun.call2 lib_open '/tmp/main-sqlite' db 66 | stmt = %0 67 | Fun.call5 lib_prepare !db 'select summary from tasks where user="0"' -1 stmt 0 68 | for !stmt 69 | 0 70 | 71 | # https://www.sqlite.org/c3ref/column_blob.html 72 | lib_column_text = Dl'sqlite3_column_text' : stmt:N? key:N? S 73 | 74 | # https://www.sqlite.org/c3ref/column_count.html 75 | lib_column_count = Dl'sqlite3_column_count' : stmt:N? N 76 | 77 | flag_row = 100 78 | for stmt:N = 79 | | Fun.call1 lib_step stmt == flag_row & 80 | Fact.do $Fun (Fun.call2 lib_column_text stmt 0 == 'foo') 81 | 0 82 | 0 83 | -------------------------------------------------------------------------------- /json.m: -------------------------------------------------------------------------------- 1 | # javascript object notation 2 | 3 | https://en.wikipedia.org/wiki/JSON 4 | 5 | term line:N column:N s:S : !Term, line2:N, column2:N, !S = 6 | x = S.char s 7 | y = x & S.char s+1 8 | | x == 0 & 0:!Term, 0, 0, 0 9 | 10 | | x == \ & term line column+1 s+1 11 | 12 | | x == 0a & term line+1 column s+1 13 | 14 | | x == \" & 15 | r, n = S.cut_line s+1 \" 0 16 | Str (S.span s+1 r), line + n, column + r-s, r + 1 17 | 18 | | x == \- & 19 | term, line2, column2, in2 = term line column+1 s+1 20 | Term.neg term, line2, column2, in2 21 | 22 | | C.is_digit x & 23 | z, r = Term.of_num s 24 | z, line, column + r-s, r 25 | 26 | | S.has '{}[]:,' x & 27 | Op (C.str x), line, column + 1, s + 1 28 | 29 | | C.is_alpha x & 30 | r = S.cut_by s+1 C.is_alpha 31 | Name (S.span s r), line, column + r-s, r 32 | 33 | | Fail.fill ':$n:$n: $s invalid character $c' [line, column, $Fun, x] 34 | 35 | str_terms line:N column:N in:S : Terms = 36 | term, line2, column2, in2 = term line column in 37 | term & term, str_terms line2 column2 in2 38 | 39 | Fact (str_terms 0 0 '{"Item":{"range":{"S":"bar"},"hash":{"S":"foo"},"item":{"S":"42"}}}' . Term.seq_str == "{ 'Item' : { 'range' : { 'S' : 'bar' } , 'hash' : { 'S' : 'foo' } , 'item' : { 'S' : '42' } } }") 40 | Fact (str_terms 0 0 '[1, 2, 3]' . Term.seq_str == '[ 1 , 2 , 3 ]') 41 | 42 | terms_tree_seq pairs:*(S, Term) : Terms? *(S, Term), Terms = 43 | Op '}', terms? [], terms 44 | terms? 45 | pair, terms2 = terms_pair terms 46 | terms2 . 47 | Op ',', terms3? terms_tree_seq pair,pairs terms3 48 | Op '}', terms3? (pair, pairs).List.rev, terms3 49 | s? Fail.main2 $Fun s.Term.seq_str 50 | 51 | terms_list_seq seq:Terms : Terms? Terms, Terms = 52 | Op ']', terms? [], terms 53 | terms? 54 | term, terms2 = terms_tree terms 55 | terms2 . 56 | Op ',', terms3? terms_list_seq term,seq terms3 57 | Op ']', terms3? (term, seq).List.rev, terms3 58 | s? Fail.main2 $Fun s.Term.seq_str 59 | 60 | terms_pair : Terms ? S,Term, Terms = 61 | Str name, (Op ':', terms)? 62 | tree, terms2 = terms_tree terms 63 | name,tree, terms2 64 | s? Fail.main2 $Fun s.Term.seq_str 65 | 66 | terms_tree : Terms ? Term, Terms = 67 | Op '{', terms? 68 | pairs, terms2 = terms_tree_seq [] terms 69 | Map pairs, terms2 70 | Op '[', terms? 71 | seqs, terms2 = terms_list_seq [] terms 72 | Terms seqs, terms2 73 | term, terms? term, terms 74 | ? Fail $Fun 75 | 76 | str_tree in:S : Term = str_terms 0 0 in . terms_tree . 0 77 | 78 | Fact (str_tree '{"Item":{"range":{"S":"bar"},"hash":{"S":"foo"},"item":{"S":"42"}}}' . str == "(Item,(range,(S,'bar') hash,(S,'foo') item,(S,'42')))") 79 | Fact (str_tree '[1, 2, 3]' . str == '(1 2 3)') 80 | Fact (str_tree '[{"x":1}]' . str == '((x,1))') 81 | Fact (str_tree '{}' . str == '()') 82 | Fact (str_tree '[{"x":[]}]' . str == '((x,()))') 83 | 84 | at key:S : Term? Term = 85 | Map pairs? Map.get S.eq pairs key | Fail.main4 $Fun 'invalid key' key (Map pairs).str 86 | Terms terms? List.at_opt key.S.nat terms | Fail.main4 $Fun 'invalid key' key (Terms terms).str 87 | Str s & key == '+'? Nat (S.nat s) 88 | term? Fail.main4 $Fun 'invalid term' key term.str 89 | Fact (at 'Item' (str_tree '{"Item":{"range":{"S":"bar"},"hash":{"S":"foo"},"item":{"S":"42"}}}') . str == "(range,(S,'bar') hash,(S,'foo') item,(S,'42'))") 90 | 91 | at_key_seq term:Term : *S? Term = 92 | key, keys? at_key_seq (at key term) keys 93 | ? term 94 | Fact (at_key_seq (str_tree '{"Item":{"range":{"S":"bar"},"hash":{"S":"foo"},"item":{"S":"42"}}}') ['Item','item','S','+'] . str == "42") 95 | Fact (at_key_seq (str_tree '{"Item":{"range":{"S":"bar"},"hash":{"S":"foo"},"item":{"S":"42"}}}') 'Item item S +'.S.words . str == "42") 96 | 97 | at_keys term:Term keys:S : S = at_key_seq term keys.S.words . str 98 | Fact (at_keys (str_tree '{"Item":{"range":{"S":"bar"},"hash":{"S":"foo"},"item":{"S":"42"}}}') 'Item item S +' == '42') 99 | Fact (at_keys (str_tree '{"foo":[1, 2, 3]}') 'foo 2' == '3') 100 | 101 | get in:S path:S : S = at_key_seq in.str_tree path.S.terms . str 102 | 103 | main path:S = get !In path . Put 104 | -------------------------------------------------------------------------------- /dynamodb.m: -------------------------------------------------------------------------------- 1 | # amazon cloud key-value database 2 | 3 | http://docs.aws.amazon.com/amazondynamodb/latest/APIReference/API.CreateTable.html 4 | 5 | sign data:S key:Mem : Mem = Common_crypto.hmac_key key data 6 | 7 | # 8 | date 9 | . Common_crypto.hmac_str 'AWS4'+key 10 | . sign region 11 | . sign service 12 | . sign 'aws4_request' 13 | 14 | date . Common_crypto.hmac_str 'AWS4'+key . sign region . sign service . sign 'aws4_request' 15 | 16 | signature_key key:S date:S region:S service:S : Mem = 17 | sign 'aws4_request' 18 | sign service 19 | sign region 20 | Common_crypto.hmac_str 'AWS4'+key date 21 | 22 | do action:S body:S : S = 23 | now = !Time.now 24 | datetime = Time.datetime_iso now.Time.gmtime 25 | date = Time.date_iso now.Time.gmtime # 20151103T230739Z 26 | region = 'us-west-1' 27 | service = 'dynamodb' 28 | 29 | access_key_id = Env.must 'AWS_ACCESS_KEY_ID' 30 | secret_access_key = Env.must 'AWS_SECRET_ACCESS_KEY' 31 | 32 | key = signature_key secret_access_key date region service 33 | method = 'POST' 34 | canonical_uri = '/' 35 | canonical_querystring = '' 36 | version = 'DynamoDB_20120810' 37 | target = version + '.' + action 38 | body_hash = Common_crypto.sha256_hex body 39 | content_type = 'application/x-amz-json-1.0' 40 | # Content-Length: 41 | host = 'dynamodb.us-west-1.amazonaws.com' 42 | canonical_headers = 'content-type:' + content_type + "\." + 'host:' + host + "\." + 'x-amz-date:' + datetime + "\." + 'x-amz-target:' + target + "\." 43 | signed_headers = 'content-type;host;x-amz-date;x-amz-target' 44 | canonical_request = method + "\." + canonical_uri + "\." + canonical_querystring + "\." + canonical_headers + "\." + signed_headers + "\." + body_hash 45 | algorithm = 'AWS4-HMAC-SHA256' 46 | credential_scope = date + '/' + region + '/' + service + '/' + 'aws4_request' 47 | string_to_sign = algorithm + "\." + datetime + "\." + credential_scope + "\." + Common_crypto.sha256_hex canonical_request 48 | signature = Common_crypto.hmac_key_hex key string_to_sign 49 | 50 | sock = Socket 0 51 | Socket.connect sock 'dynamodb.us-west-1.amazonaws.com' 80 52 | 53 | request = S.fill 'POST / HTTP/1.1 54 | Content-Length: $n 55 | Connection: close 56 | X-Amz-Target: $s 57 | Host: dynamodb.us-west-1.amazonaws.com 58 | X-Amz-Date: $s 59 | Content-Type: application/x-amz-json-1.0 60 | Authorization: AWS4-HMAC-SHA256 Credential=AKIAJEG264NCS4QOTZMQ/$s/us-west-1/dynamodb/aws4_request,SignedHeaders=content-type;host;x-amz-date;x-amz-target,Signature=$s 61 | 62 | $s' [body.S.size, target, datetime, date, signature, body] 63 | File.out sock.File.of request 64 | File.in_read sock.File.of 65 | 66 | # {"__type":"com.amazon.coral.service#UnknownOperationException"} 67 | # {"__type":"com.amazon.coral.service#InvalidSignatureException","message":".."} 68 | 69 | # http://docs.aws.amazon.com/amazondynamodb/latest/APIReference/API_PutItem.html 70 | put2 hash:S range:S item:S : S = do 'PutItem' (S.fill '{"TableName": "000", "Item": {"hash": {"S": "$s"}, "range": {"S": "$s"}, "item": {"S": "$s"}}}' [hash, range, item]) . reply 71 | 72 | put hash:S item:S : S = put2 hash '_' item . reply 73 | 74 | reply x:S : S = S.rget x 0a + 1 75 | 76 | # len('{"Item":{"range":{"S":""},"hash":{"S":""},"item":{"S":"') = 55 77 | # len('"}}}') = 4 78 | item x:S hash:S range:S : S = S.spanx x (55 + hash.S.size + range.S.size) -5 79 | 80 | # http://docs.aws.amazon.com/amazondynamodb/latest/APIReference/API_GetItem.html 81 | # {"Item":{"range":{"S":"bar"},"hash":{"S":"foo"},"item":{"S":"42"}}} 82 | get2 hash:S range:S : S = item (do 'GetItem' (S.fill '{"TableName": "000", "Key": {"hash": {"S": "$s"}, "range": {"S": "$s"}}}' [hash, range]) . reply) hash range 83 | 84 | get hash:S : S = get2 hash '_' 85 | 86 | # 87 | sudo easy_install boto 88 | import boto.dynamodb 89 | s = boto.dynamodb.connect_to_region('us-west-1', aws_access_key_id='???', aws_secret_access_key='???') 90 | s.create_table('000', s.create_schema('hash', '', 'range', ''), 1, 1) 91 | test _ = 92 | Fact.do $Fun (do 'ListTables' '{}' . reply == '{"TableNames":["000"]}') 93 | put 'foo' '13' 94 | Fact.do $Fun (get 'foo' == '13') 95 | 96 | put2 'foo' 'bar' '42' 97 | Fact.do $Fun (get2 'foo' 'bar' == '42') 98 | Fact.do $Fun (get 'foo' == '13') 99 | 0 100 | -------------------------------------------------------------------------------- /tag.m: -------------------------------------------------------------------------------- 1 | # tagged union, enum, algebraic data type 2 | 3 | https://en.wikipedia.org/wiki/Algebraic_data_type 4 | https://en.wikipedia.org/wiki/Tagged_union 5 | 6 | # 1 - 210 in term.m 7 | Add = 1010 8 | And = 1011 9 | Xor = 1012 10 | Or = 1013 11 | Sub = 1014 12 | Cmp = 1015 13 | Shl = 1016 14 | Shr = 1017 15 | Mul = 1018 16 | Div = 1019 17 | Mod = 1020 18 | Neg = 10200 19 | 20 | Call = 1021 21 | Enter = 1022 22 | Leave = 1023 23 | J = 1024 24 | Mov = 1025 25 | Movsx = 10225 26 | Lea = 1026 27 | Test = 1027 28 | Not = 1028 29 | Push = 1029 30 | Pop = 1030 31 | Ret = 1031 32 | Syscall = 1032 33 | Rdtsc = 1033 34 | Cpuid = 1034 35 | Set_ = 1035 36 | Pause = 1036 37 | Xchg = 1037 # lock+inc lock+add dec xadd cmpxchg cmpxchg8b cmpxchg16b 38 | Cmpxchg = 1038 39 | 40 | Base = 1040 41 | Span = 1041 42 | Label = 1042 43 | New = 1043 44 | 45 | A = 1050 46 | Ah = 1051 47 | B_ = 1052 48 | Bh = 1053 49 | C = 1054 50 | Ch = 1055 51 | D = 1056 52 | Dh = 1057 53 | Sp = 1058 54 | Bp = 1059 55 | Si = 1060 56 | Di = 1061 57 | R8 = 1062 58 | R9 = 1063 59 | R10 = 1064 60 | R11 = 1065 61 | R12 = 1066 62 | R13 = 1067 63 | R14 = 1068 64 | R15 = 1069 65 | Xmm0 = 10300 66 | Xmm1 = 10301 67 | 68 | O = 1070 69 | No = 1071 70 | 71 | L = 1072 72 | Sl = 1082 73 | Ge = 1073 74 | Sge = 1083 75 | 76 | E = 1074 77 | Ne = 1075 78 | 79 | Le = 1076 80 | Sle = 1086 81 | G = 1077 82 | Sg = 1087 83 | 84 | S__ = 1078 85 | Ns = 1079 86 | P = 1080 87 | Np = 1081 88 | 89 | Z_ = 10120 90 | B = 10121 91 | C_ = 10122 92 | S_ = 10123 93 | R_ = 10124 94 | 95 | N0 = 10130 96 | N1 = 10131 97 | N2 = 10132 98 | N = 10133 99 | I = 10134 100 | 101 | # Next Def Type At Fun 102 | # Or And Pair By 103 | # Eq Ne Lt Le Gt Ge 104 | # Not Add Sub Mul Div Mod Pow 105 | # unary: !not !opt %ref +seq 106 | 107 | Flag x:N : Term = Cast.any (Term.Flag_tag, x) # fixme with Tag def - Flag x:Flag 108 | Reg x:N : Term = Cast.any (Term.Reg_tag, x) # fixme with Tag def - Reg x:Reg 109 | Char x:C : Term = Cast.any (Term.Char_tag, x) 110 | Nat x:N : Term = Cast.any (Term.Nat_tag, x) # binding, type variable 111 | Tnat x:N : Term = Cast.any (Term.Tnat_tag, x) # type for natural literals 112 | Str x:S : Term = Cast.any (Term.Str_tag, x) 113 | Real x:R : Term = Cast.any (Term.Real_tag, x) 114 | Mem_ x:N,Mem : Term = Cast.any (Term.Mem_tag, x) 115 | Name x:S : Term = Cast.any (Term.Name_tag, x) 116 | Name2 x:S y:S : Term = Cast.any (Term.Name2_tag, (x, y)) 117 | Op x:S : Term = Cast.any (Term.Op_tag, x) 118 | Level x:N : Term = Cast.any (Term.Level_tag, x) 119 | Tree x:Exps : Term = Cast.any (Term.Tree_tag, x) 120 | Listx x:Exps : Term = Cast.any (Term.Listx_tag, x) 121 | Listy x:Exp : Term = Cast.any (Term.Listy_tag, x) 122 | Meta x:S : Term = Cast.any (Term.Meta_tag, x) 123 | Pre o:S x:Exp : Term = Cast.any (Term.Pre_tag, (o, x)) 124 | Post x:Exp o:S : Term = Cast.any (Term.Post_tag, (x, o)) 125 | Binary x:Exp o:S y:Exp : Term = Cast.any (Term.Binary_tag, (x, o, y)) 126 | Row_ s:Exps : Term = Cast.any (Term.Row_tag, s) 127 | 128 | # Node a:0~1 hash:N x:0 y:1 b:0~1 : 0~1 = Cast.any (Term.Node_tag, (a, hash, x, y, b)) 129 | 130 | #Key x:S y:Term : Term = Cast.any (Term.Key_tag, (x, y)) 131 | Terms s:Terms : Term = Cast.any (Term.Terms_tag, s) # Json 132 | Map s:*(S, Term) : Term = Cast.any (Term.Map_tag, s) # Json 133 | 134 | #Snil = 0 135 | Snil _ : +0 = Cast.any 0 136 | Sone x:0 : +0 = Cast.any (Term.Sone_tag, x) # one, singleton 137 | Slink x:0 s:+0 : +0 = Cast.any (Term.Slink_tag, (x, s)) # cons, next 138 | Sadd r:+0 s:+0 : +0 = Cast.any (Term.Sadd_tag, (r, s)) # two, merge 139 | Slist x:*0 : +0 = Cast.any (Term.Slist_tag, x) # List 140 | Sseq s:*+0 : +0 = Cast.any (Term.Sseq_tag, s) # join, concat, merge 141 | 142 | Sstr n:N s:S : +C = Cast.any (Term.Sstr_tag, (n, s)) 143 | Sfun n:!N f:Z?!0 : +0 = Cast.any (Term.Sfun_tag, (n, f)) # unfold 144 | 145 | Sskip n:N s:+0 : +0 = Cast.any (Term.Sskip_tag, (n, s)) 146 | Stake n:N s:+0 : +0 = Cast.any (Term.Stake_tag, (n, s)) # 147 | Srow n:N s:Mem : +0 = Cast.any (Term.Srow_tag, (n, s)) 148 | Smap f:0?1 s:+0 : +1 = Cast.any (Term.Smap_tag, (f, s)) 149 | Skeep f:0?B s:+0 : +1 = Cast.any (Term.Skeep_tag, (f, s)) # take_nat 150 | Spair r:+0 s:+0 : +(0,1) = Cast.any (Term.Spair_tag, (r, s)) # zip, with 151 | # push - add to tail? 152 | 153 | _tick = %0 : %N 154 | 155 | name _ : S = Name.add 'Tag' _tick 156 | -------------------------------------------------------------------------------- /rule.m: -------------------------------------------------------------------------------- 1 | # rewrite rule, pattern matching 2 | 3 | https://en.wikipedia.org/wiki/Pattern_matching 4 | http://en.wikipedia.org/wiki/Guard_(computer_science) 5 | 6 | # f x,y:t : u = a -> f z:t : u = (x,y = z; a) 7 | # f z=x,y:t : u = a -> f z:t : u = (x,y = z; a) 8 | binds : rule:Exp? arg:Exp, body:Exps = 9 | # todo - generalize for arbitrary equal-rule (use tests_binds below?) such as f x=(y,z=(u,v)):t 10 | # vs default argument f x:N=3 : t = a 11 | spot, Binary name '=' (_, Binary (_, Row rules) ':' type)? # note, f z=(x,y:t) not f (z=x,y):t 12 | (spot, Binary name ':' type), [(spot, Binary (spot, Row_ rules) '=' name)] 13 | 14 | _, Binary (spot, Row rules) ':' type? 15 | name = spot, Name 'x'.S.tick 16 | (spot, Binary name ':' type), [(spot, Binary (spot, Row_ rules) '=' name)] 17 | 18 | exp? exp, [] 19 | 20 | test_bind_row arg,size:Exp,N index:N rule:Exp : Exps, Exps = 21 | spot = Exp.spot arg 22 | tests_binds rule (spot, Tree [(spot, Row.name size index), arg]) 23 | 24 | # {A?a e} => {{[A == e], [], a}} => tag e == A & a 25 | # {x?a e} => {{[], [x = e], a}} => (x = e; a) 26 | # {A,B?a e} => {{[tag e.0 == A, tag e.1 == B], [], a}} => tag e.0 == A & tag e.1 == B & a 27 | # {A,x?a e} => {{[tag e.0 == A], [x == e.1], a}} => tag e.0 == A & (x = e.1; a) 28 | # {(A B)?a e} => {{[tag e.0 == A, tag e.term == B], [], a}} => tag e.0 == A & tag e.term == B & a 29 | # http://research.microsoft.com/pubs/79947/p29-syme.pdf# Extensible Pattern Matching Via a Lightweight Language Extension, [Don Syme, Microsoft Research] 30 | tests_binds rule:Exp arg:Exp : Exps, Exps = 31 | spot = Exp.spot rule 32 | rule.Exp.tree . 33 | Char _? [(spot, Binary arg '==' rule)], 0 # c 34 | 35 | Nat _? [(spot, Binary arg '==' rule)], 0 # n 36 | 37 | Str _? [(spot, Tree [(spot, Name2 'S' 'eq'), rule, arg])], 0 # S.eq 38 | 39 | Name x & x.S.char.C.is_upper? [(spot, Binary arg '==' rule)], 0 # tag X 40 | Name _? 0, [(spot, Binary rule '=' arg)] # var - (x? a) b => x = b; a 41 | Name2 _ _? [(spot, Binary arg '==' rule)], 0 # tag X 42 | 43 | Binary rule2 '&' test? # {r & e} => [t & (b; e)], b @ t, b = {r} 44 | tests, binds = tests_binds rule2 arg 45 | test2 = Exp.binary_exps ';' binds+[test] 46 | Exp.binary_exps '&' tests+[test2] . Opt.seq, binds 47 | 48 | Listy rule2? tests_binds rule2 arg # fixme 49 | 50 | Row [rule2]? tests_binds rule2 arg # fixme, singleton row - n for [Nat n] is not boxed 51 | 52 | Row rules? # {r1, r2} => [t1 & t2], b1 + b2 @ t1, b1 = {r1}; t2, b2 = {r2} 53 | tests, binds = List.map_at rules (test_bind_row arg,!rules) 0 . List.unzip 54 | # must group the tests here, else: (A, B? a; b) (A, C) gives 0 not b because A=A then B!=C instead of A=A and B!=C before branching 55 | test = spot, Tree [(spot, Name2 'B' 'cast'), arg] # B.cast - todo - only check arg.Bit for t,u! (opt type) 56 | Exp.binary_exps '&' (test, List.adds tests) . Opt.seq, List.adds binds 57 | 58 | # - todo 59 | # f z=x,y:t : u = a 60 | # f z:t : u = (x,y = z; a) 61 | # f z:t : u = (z = x,y; a) 62 | Binary rule1 '=' rule2? # alias {x = r} => t, (x = r), b @ t, b = {r} 63 | tests, binds = tests_binds rule2 arg 64 | tests, ((spot, Binary rule1 '=' arg), binds) 65 | 66 | Tree (_, Name name),rules & name.S.char.C.is_upper? # {X r..} a => [t1 & t2], b1 + b2 @ t1, b1 = {[X]_tag} a.term_tag; t2, b2 = {r2} a.[X]_item 67 | arg0 = spot, Tree [(spot, Name2 'Term' 'tag'), arg] 68 | arg1 = spot, Tree [(spot, Name2 'Term' name+'_term'), arg] 69 | tests0, binds0 = tests_binds (spot, Name2 'Term' name+'_tag') arg0 # t1, b1 = {[X]_Tag} a.term_tag 70 | tests1, binds1 = tests_binds (spot, Row_ rules) arg1 # t2, b2 = {r2} a.[X]_item 71 | # must group the tests here, else: (A, B? a; b) (A, C) gives 0 not b because A=A then B!=C instead of A=A and B!=C before branching 72 | Exp.binary_exps '&' tests0+tests1 . Opt.seq, binds0+binds1 73 | 74 | ? Exp.seq_error $Fun 'invalid' [rule, arg] 75 | 76 | bind_exp bind:!Exp exp:Exp : Exp = 77 | bind & Exp.spot bind, Binary bind ';' exp | exp 78 | 79 | # arg must be generated via [Exp.bind_name] so that bind_exp around the outermost (a?b; c?d) in rewrite_exps 80 | rewrite rule:Exp body:Exp arg:Exp : Exp = # (rule? body) arg 81 | bind, arg2 = Exp.bind_name arg 82 | tests, binds = tests_binds rule arg2 83 | # rewrite_match must not rewrite_exp, so that 84 | # (a? b; c) d --> (op_if (op_if (== a d) b 0) (op_if (== a d) b 0) (c d)) 85 | # vs the correct (op_if (== a d) b (c d)) 86 | bind_exp bind (Exp.binary_exps '&' (tests + (Exp.binary_exps ';' binds+[body] . Opt.seq)) . Opt.main0) 87 | -------------------------------------------------------------------------------- /sys.m: -------------------------------------------------------------------------------- 1 | # system call, kernel call 2 | 3 | # http://www.opensource.apple.com/source/xnu/xnu-2782.20.48/bsd/kern/syscalls.master 4 | # user - rdi, rsi, rdx, rcx, r8 and r9 5 | # sys - rdi, rsi, rdx, r10, r8 and r9 6 | # returns - rax, rdx 7 | call g:N a:N b:N c:N d:N e:N f:N : N = Asm 8 | mov a sp 56 9 | add a 02000000 10 | mov di sp 48 11 | mov si sp 40 12 | mov d sp 32 13 | mov r10 sp 24 14 | mov r8 sp 16 15 | mov r9 sp 8 16 | syscall 17 | j ge Sys.call0 18 | neg a 19 | @Sys.call0 20 | mov sp 64 a 21 | ret 22 | 23 | # return a pair, first component is negative if any error 24 | # call2 g:N a:N b:N c:N d:N e:N f:N : N, N = Asm 25 | call2 g:N a:N b:N c:N d:N e:N f:N : N = Asm 26 | mov a sp 56 27 | add a 02000000 28 | mov di sp 48 29 | mov si sp 40 30 | mov d sp 32 31 | mov r10 sp 24 32 | mov r8 sp 16 33 | mov r9 sp 8 34 | syscall 35 | j ge Sys.call2_0 36 | neg a 37 | @Sys.call2_0 38 | 39 | mov r11 16 40 | call Mem.main_reg 41 | mov sp 64 r11 42 | mov r11 0 a 43 | mov r11 8 d 44 | ret 45 | 46 | write file:N x:S size:N : N = Asm 47 | mov a 02000004 48 | mov di sp 24 # output file 49 | mov si sp 16 # buffer address 50 | mov d sp 8 # buffer size 51 | syscall 52 | mov sp 32 a # bytes written 53 | ret 54 | 55 | write0 file:N x:C : N = Asm 56 | mov a 02000004 57 | mov di sp 16 # output file 58 | lea si sp 8 # buffer address 59 | mov d 1 # buffer size 60 | syscall 61 | mov sp 24 a # bytes written 62 | ret 63 | 64 | exit x:N : 0 = Asm 65 | mov a 02000001 66 | mov di sp 8 67 | syscall 68 | 69 | read file:N x:S size:N : N = Asm 70 | mov a 02000003 71 | mov di sp 24 # input file 72 | mov si sp 16 # buffer address 73 | mov d sp 8 # buffer size 74 | syscall 75 | mov sp 32 a # bytes written 76 | ret 77 | 78 | stat path:S : N = 79 | s = Mem 144 80 | callx 190 path.S.nat s.Mem.nat 0 0 0 0 # lstat, stat = 188 81 | (s + 72).Mem.get 82 | 83 | fstat file:File : N = 84 | s = Mem 144 85 | callx 189 file.File.to s.Mem.nat 0 0 0 0 86 | (s + 72).Mem.get 87 | 88 | fork _ : N = callx 2 0 0 0 0 0 0 89 | vfork _ : N = callx 66 0 0 0 0 0 0 90 | 91 | callx g:N a:N b:N c:N d:N e:N f:N : N = 92 | x = call g a b c d e f 93 | I.lt x 0 & Fail.main2 (-x).error (-x).N.str | x 94 | 95 | callx2 g:N a:N b:N c:N d:N e:N f:N : N, N = 96 | x = call2 g a b c d e f 97 | I.lt x 0 & Fail.main2 (-x).error (-x).N.str | Mem.get x.Cast.mem, Mem.get (x+8).Cast.mem 98 | 99 | # 7 AUE_WAIT4 ALL { int wait4(int pid, user_addr_t status, int options, user_addr_t rusage) NO_SYSCALL_STUB; } 100 | # wait pid:N : N = callx 84 pid 0 0 0 0 0 # Bad system call: 12 101 | 102 | # 20 AUE_GETPID ALL { int getpid(void); } 103 | getpid _ : N = callx 20 0 0 0 0 0 0 104 | 105 | # char * strerror(int errnum); 106 | lib_errno = Dl 'errno' . Cast.any : %N 107 | 108 | lib_strerror = Dl 'strerror' : error:N? S 109 | 110 | error x:N : S = Fun.call1 lib_strerror x 111 | 112 | # int pipe(int fildes[2]); 113 | pipe _ : N, N = callx2 42 0 0 0 0 0 0 # __pipe.s returns multiple arguments - %eax, %edx 114 | 115 | dup2 old:N new:N : N = callx 90 old new 0 0 0 0 # __pipe.s returns multiple arguments - %eax, %edx 116 | 117 | # int setitimer(int which, const struct itimerval *restrict value, struct itimerval *restrict ovalue); 118 | sigaction kind:N do:N?Z : N = # NO_SYSCALL_STUB, probably changed params. use Posix for now 119 | s = do, 0, 0 120 | callx 46 kind s.Cast.nat 0 0 0 0 # kill -11 `pgrep min` 121 | 122 | # updated by Asm.steps_binary_out, used by Call.main 123 | call_head _ : N = Asm 124 | mov a Call_head 125 | mov sp 16 a 126 | ret 127 | 128 | # updated by Asm.steps_binary_out, used by Call.main 129 | call_size _ : N = Asm 130 | mov a Call_size 131 | mov sp 16 a 132 | ret 133 | 134 | # see Thread.m 135 | # 360 AUE_NULL ALL { user_addr_t bsdthread_create(user_addr_t func, user_addr_t func_arg, user_addr_t stack, user_addr_t pthread, uint32_t flags) NO_SYSCALL_STUB; } 136 | # [fun] must use c-calling convention 137 | bsdthread_create fun:0?1 x:0 : N = callx 360 fun.Cast.any x (Mem 10_000_000).Mem.nat 0 0 0 # 10MB stack 138 | 139 | #361 AUE_NULL ALL { int bsdthread_terminate(user_addr_t stackaddr, size_t freesize, uint32_t port, uint32_t sem) NO_SYSCALL_STUB; } 140 | bsdthread_terminate _ : N = callx 361 0 0 0 0 0 0 141 | 142 | cpuid _ = Asm # serializing, flush pipeline, ~200 cycles http://www.agner.org/optimize/instruction_tables.pdf 143 | cpuid 144 | ret 145 | 146 | mfence _ = Asm 147 | 0f 0ae 0f0 148 | ret 149 | 150 | pause _ = Asm 151 | pause 152 | ret 153 | 154 | di _ : N = Asm # hack! first parameter for callback with c-calling convention, for Thread.create 155 | mov sp 16 di 156 | ret 157 | 158 | set_di x:N = Asm # for Thread.create0 159 | mov di sp 8 160 | ret 161 | -------------------------------------------------------------------------------- /r.m: -------------------------------------------------------------------------------- 1 | # real, floating-point number 2 | 3 | https://en.wikipedia.org/wiki/IEEE_floating_point 4 | https://en.wikipedia.org/wiki/Scientific_notation 5 | http://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html What Every Computer Scientist Should Know About Floating-Point Arithmetic 6 | 7 | of x:S : R = Fun.call_nr Dl'atof' x 8 | Fact (of '3.1415' == 04009_21ca_c083_126f.N.real) 9 | Fact (of '3.1415' . Cast.real_bits == 04009_21ca_c083_126f) 10 | Fact (of '3.14' == 3.14) 11 | 12 | of3 x:S y:S z:S : R = S.fill '$s.$se$s' [x, y, z] . of 13 | 14 | of_exp x:S y:S : R = S.fill '$se$s' [x, y] . of 15 | 16 | of2 x:N y:N : R = of (S.add3 x.N.str '.' y.N.str) 17 | Fact (of2 3 14 == 3.14) 18 | 19 | # http://www.cplusplus.com/reference/cstdlib/strtod/ 20 | strtod x:S : R = Fun.call1 Dl'strtod' x 21 | 22 | floor x:R : N = Fun.call1 Dl'floor' x 23 | 24 | epsilon = 0.00001 : R 25 | 26 | mod x:R y:R : R = Fun.call_rrr Dl'fmod' x y 27 | Fact (mod 5. 2. == 1.) 28 | 29 | abs x:R : R = Fun.call_rr Dl'fabs' x 30 | Fact (abs 2. == 2.) 31 | 32 | sub x:R y:R : R = Asm 33 | 0'f20f10442410 f20f5c442408 f20f11442418' 34 | ret 35 | Fact (5. - 2. == 3.) 36 | 37 | add x:R y:R : R = Asm 38 | 0'f20f10442410 f20f58442408 f20f11442418' 39 | ret 40 | Fact (5. + 2. == 7.) 41 | 42 | neg x:R : R = Asm 43 | 0'b800000000 66480f6ec0 f20f5c442408 f20f11442410' 44 | ret 45 | Fact (neg 5. == 0. - 5.) 46 | 47 | mul x:R y:R : R = Asm 48 | 0'f20f10442410 f20f59442408 f20f11442418' 49 | ret 50 | Fact (5.*2. == 10.) 51 | 52 | div x:R y:R : R = Asm 53 | 0'f20f10442410 f20f5e442408 f20f11442418' 54 | ret 55 | Fact (5. / 2. == 2.5) 56 | 57 | lt x:R y:R = Asm 58 | 0'f20f10442410 f20fc244240801 f20f11442418' 59 | ret 60 | Fact (2. < 5.) 61 | Fact !(5. < 2.) 62 | 63 | # https://docs.python.org/3/library/math.html#math.isclose 64 | sim x:R y:R : B = abs (x - y) < epsilon 65 | close x:R y:R : B = abs (x - y) < epsilon 66 | Fact (close 3.141592 3.141593) # 3.141592653589793 67 | Fact (close 3.141592 _1000_0000_0001_0010_0100_0011_1111_0101_1111_1001_0001_0110_0000_0000_1111_010.N.real) 68 | Fact !(close 3.14159 3.14) 69 | Fact !(close 4. 2.) 70 | Fact !(close 2. 4.) 71 | Fact (3.141592 ≈ 3.141593) 72 | 73 | log x:R : R = Fun.call_rr Dl'log' x 74 | Fact (close (log 2.) 0.6931471805599453) 75 | 76 | # https://software.intel.com/en-us/node/522659 Exponential Functions 77 | exp x:R : R = Fun.call_rr Dl'exp' x 78 | Fact (exp 1. . str == '2.71828') # import math; '%g' % math.exp(1) 79 | 80 | ℯ = exp 1. : R 81 | Fact (close ℯ 2.71828) 82 | Fact (close ℯ^2. 7.38906) 83 | 84 | cos x:R : R = Fun.call_rr Dl'cos' x 85 | Fact (cos 0 == 03ff0_0000_0000_0000.N.real) # 1.0 86 | Fact (cos 3.14 == 0bfef_fffd_5719_f5d7.N.real) # -0.9999987317275395 87 | 88 | nat x:R : N = Cast.real_bits x 89 | 90 | lib_printf = 'printf'.Dl : Z? Z 91 | 92 | sprintf1f_raw f:0 out:S format:S x:1 = Asm 93 | mov r11 sp 32 94 | mov di sp 24 95 | mov si sp 16 96 | mov a sp 8 97 | mov xmm0 a 98 | mov bp sp 99 | and sp 0ffff_fff0 100 | mov a 1 # num of parameters in xmms 101 | call r11 102 | mov sp bp 103 | ret 104 | 105 | str9 x:R : S = (y = S.new 10; sprintf1f_raw S.lib_sprintf y '%.9g' x; y) # 9 significant digits + dot 106 | Fact (3.141592653589793.str9 == '3.14159265') # import math; '%.g' % math.pi 107 | 108 | str x:R : S = (y = S.new 7; sprintf1f_raw S.lib_sprintf y '%g' x; y) # default 6 significant digits + dot 109 | Fact (str 3.141592653589793 == '3.14159') # import math; '%g' % math.pi 110 | Fact ('3.1415'.of.str == '3.1415') 111 | Fact (3.1415.str == '3.1415') 112 | 113 | # https://en.wikipedia.org/wiki/Error_function error 114 | erf x:R : R = Fun.call_rr Dl'erf' x # import math; math.erf(1) == 0.842700792949715 115 | Fact(close (erf 1.) 0.842700793) # 03fea_f767_a741_088a 116 | 117 | erfc x:R : R = Fun.call_rr Dl'erfc' x # import math; math.erf(1) == 0.842700792949715 118 | 119 | # 120 | import struct; hex(struct.unpack('>Q', struct.pack('>d', math.pi))[0]) # 0x400921fb54442d18 121 | import struct; hex(struct.unpack('>Q', struct.pack('>d', 3.1415))[0]) # 0x400921cac083126f 122 | # 1000_0000_0001_0010_0100_0011_1111_0101_1111_1001_0001_0110_0000_0000_1111_010 123 | import struct; '_'.join(map(''.join, re.findall('....?', bin(struct.unpack('>Q', struct.pack('>d', 3.141592))[0])[2:]))) 124 | import struct; hex(struct.unpack('>I', struct.pack('>f', 3.1415))[0]) # 0x40490e56 125 | import struct; hex(struct.unpack('>I', struct.pack('>f', math.pi))[0]) # 0x40490fdb 126 | import struct; hex(struct.unpack('>I', struct.pack('>f', 1))[0]) # 0x3f800000 127 | π = 3.14159265358979323846264338327950288 # 04009_21fb_5444_2d18 128 | Fact (π ≈ 3.14159) # pi 129 | 130 | pow x:R y:R : R = Fun.call_rrr Dl'pow' x y 131 | Fact (close (pow 3.14 0.5) 1.772) 132 | Fact (close 3.14^0.5 1.772) 133 | 134 | # 135 | https://en.wikipedia.org/wiki/NaN 136 | non = 0_111_1111 137 | +inf 07ff0_0000_0000_0000 138 | -inf 0fff0_0000_0000_0000 139 | nan 07ff0_ffff_ffff_ffff 140 | 141 | √ x:R : R = Fun.call_rr Dl'sqrt' x 142 | Fact (close √3.14 1.772) 143 | Fact (close 2.√π 3.5449077018110318) # 2*math.sqrt(math.pi) 144 | 145 | # https://en.wikipedia.org/wiki/Cumulative_distribution_function cumulative normal distribution 146 | cdf x:R : R = ½ * erfc(-√½ * x) 147 | ϕ x:R : R = ½ * erfc(-√½ * x) 148 | Fact (close (ϕ 1.) 0.84134474606854293) # from scipy.stats import norm; norm.cdf(1) 149 | 150 | # http://www.cygnus-software.com/papers/comparingfloats/Comparing%20floating%20point%20numbers.htm 151 | # https://docs.oracle.com/javase/8/docs/api/java/lang/Double.html#equals-java.lang.Object- 152 | # https://en.wikipedia.org/wiki/Machine_epsilon 153 | # http://floating-point-gui.de/errors/comparison/ 154 | eq x:R y:R : B = N.eq x.nat y.nat 155 | -------------------------------------------------------------------------------- /mem.m: -------------------------------------------------------------------------------- 1 | # memory address, pointer 2 | 3 | get s:Mem : N = Asm # inlined in Step.exp_steps 4 | mov a sp 8 5 | mov c a 0 6 | mov sp 16 c 7 | ret 8 | 9 | get0 s:Mem : C = Asm 10 | mov a sp 8 11 | mov c 0 12 | 0 mov c a 0 13 | mov sp 16 c 14 | ret 15 | 16 | set s:Mem x:0 = Asm 17 | mov a sp 16 18 | mov c sp 8 19 | mov a 0 c 20 | mov sp 24 0 21 | ret 22 | 23 | set0 s:Mem x:C = Asm 24 | mov a sp 16 25 | mov c sp 8 26 | 0 mov a 0 c 27 | mov sp 24 0 28 | ret 29 | Fact (eq (x = 'bafe'.of; set0 x \c; x) 'cafe'.of 4) 30 | 31 | # https://en.wikipedia.org/wiki/C_dynamic_memory_allocation 32 | main size:N : Mem = Asm 33 | mov r11 sp 8 34 | call Mem.main_reg # todo - thread local memory pages to avoid contention in xadd 35 | mov sp 16 r11 36 | ret 37 | 38 | _main_hack _ : N = 1 + 1 # hack! align for main_reg below 39 | 40 | # use [r10], arg/ret = [r11] 41 | todo - thread-local pages for memory allocation without lock 42 | fixme - random 100x slower when lock on unaligned. currently, put unused instructions in _main_hack above to force align 43 | 44 | http://www.agner.org/optimize/instruction_tables.pdf 45 | Instructions with a LOCK prefix have a long latency that depends on cache organization and possibly RAM speed. If there 46 | are multiple processors or cores or direct memory access (DMA) devices then all locked instructions will lock a cache 47 | line for exclusive access, which may involve RAM access. A LOCK prefix typically costs more than a hundred clock cycles, 48 | even on single-processor systems. This also applies to the XCHG instruction with a memory operand. 49 | main_reg size:N : Mem = Asm 50 | mov r10 Data_vmend 51 | cmp r10 8 0 # see main.ma for Job.multi 52 | j ne Mem.main_reg_1 53 | 0'4d0fc11a' # xadd r10 0 r11, 20% faster 54 | ret 55 | 56 | @Mem.main_reg_1 57 | 0'f04d0fc11a' # lock; xadd r10 0 r11 58 | ret 59 | 60 | main2 size:N : Mem = _ 61 | 62 | nat s:Mem : N = Cast.mem_nat s 63 | 64 | id r:Mem s:Mem : B = nat r == nat s 65 | 66 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/memcmp.3.html 67 | # int memcmp(const void *s1, const void *s2, size_t n); 68 | lib_memcmp = Dl 'memcmp' : Mem? Mem? size:N? N 69 | eq r:Mem s:Mem n:N : B = Fun.call3 lib_memcmp r s n == 0 70 | 71 | of x:0 : Mem = Cast.mem x 72 | 73 | at s:Mem : Mem = s.get.of 74 | 75 | off s:Mem index:N : Mem = Mem.of (s + index) # todo - rename to add? 76 | Fact (s = 13,42 . of; off s 8 . get == 42) 77 | 78 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/memcpy.3.html 79 | # void * memcpy(void *restrict dst, const void *restrict src, size_t n); 80 | lib_memcpy = Dl 'memcpy' : to:Mem? from:Mem? size:N? dst:Mem 81 | copy r:Mem s:Mem n:N = (Fun.call3 lib_memcpy s r n; 0) 82 | 83 | rev x:Mem y:Mem n:N = n & (set0 y (get0 x+n-1); rev x y+1 n-1) 84 | 85 | copy0 r:Mem s:Mem n:N = n & (set0 s (get0 r); copy r+1 s+1 n-1) # from r to s. return 0 86 | 87 | dup s:Mem n:N : Mem = (r = n.main; copy s r n; r) 88 | 89 | span r:Mem s:Mem : Mem = dup r s-r 90 | 91 | add x:Mem n:N = set x x.get+n 92 | 93 | set1x s:Mem x:N = Asm 94 | mov a sp 16 95 | mov c sp 8 96 | 1 mov a 0 c 97 | mov sp 24 0 98 | ret 99 | 100 | set1 s:Mem x:N = (set0 s x.N.char; set0 s+1 (N.shr x 8).N.char) 101 | Fact (eq (x = '--fe'.of; set1 x (N.of1 \a \c); x) 'cafe'.of 4) 102 | 103 | # network order 104 | net_set1 s:Mem x:N = (set0 s+1 x.N.char; set0 s (N.shr x 8).N.char) 105 | 106 | set2x s:Mem x:N = Asm 107 | mov a sp 16 108 | mov c sp 8 109 | 2 mov a 0 c 110 | mov sp 24 0 111 | ret 112 | 113 | set2 s:Mem x:N = (set1 s x; set1 s+2 (N.shr x 16)) 114 | Fact (eq (x = '----babe'.of; set2 x (N.of2 \e \f \a \c); x) 'cafebabe'.of 8) 115 | 116 | set3 s:Mem x:N = (set2 s x; set2 s+4 (N.shr x 32)) 117 | Fact (eq (x = '--------deadbeef'.of; set3 x (N.of3 \e \b \a \b \e \f \a \c); x) 'cafebabedeadbeef'.of 16) 118 | 119 | set_rank s:Mem x:N : N?Z = 120 | 0? set0 s x.N.char 121 | 1? set1 s x 122 | 2? set2 s x 123 | 3? set3 s x 124 | 125 | str x:Mem : S = Cast.mem_str x 126 | 127 | log x:0 = x.Hex.str.Log 128 | 129 | put x:0 = x.Hex.str.Put 130 | 131 | line0 s:Mem i:N size:N = (Hex.n0_out (Mem.off s i).get0.C.nat; i % 2 == 1 & i != size - 1 & C.out \ ) 132 | 133 | do s:Mem index:N size:N f:0?N?N?Z = index < size & (f s index size; do s index+1 size f) # per 1 byte 134 | 135 | line s:Mem size:N = (do s 0 size line0; C.out 0a) 136 | 137 | next s:Mem size:N : Mem = s + size 138 | 139 | hex0 r:S s:Mem i:N = 140 | x = get s+i 141 | S.set (r + 2*i) (x / 16).Hex.char 142 | S.set (r + 2*i + 1) (x % 16).Hex.char 143 | 144 | hex s:Mem n:N : S = 145 | r = S.new 2*n 146 | N.for n (hex0 r s) 147 | r 148 | Fact (hex 'cafe'.of 4 == '63616665') 149 | 150 | seq s:Mem : *0 = (x = at s; x & Cast.any x, seq (s + 8)) # must be null-terminated 151 | Fact (13,42,0 . of . seq == [13, 42]) 152 | Fact (Row.of [13,42,0] . of . seq == [13, 42]) 153 | Fact (3,13,42,0 . of . seq == [3, 13, 42]) 154 | 155 | base s:0 n:N : 1 = get (s + n).of . Cast.any 156 | 157 | base2 s:0 m:N n:N : 1 = base (base s m) n 158 | 159 | base3 s:0 m:N n:N p:N : 1 = base (base (base s m) n) p 160 | 161 | gt r:Mem s:Mem : B = r.nat > s.nat 162 | 163 | of_hex_to s:S n:N r:Mem : N = 164 | x = S.char s 165 | | C.is_hex x & 166 | y = S.char s+1 167 | | y & 168 | set0 r (16*x.C.hex + y.C.hex) 169 | of_hex_to s+2 n+1 r+1 170 | | n 171 | | x & of_hex_to s+1 n r | n 172 | 173 | of_hex s:S : N, Mem = (r = Mem s.S.size/2; of_hex_to s 0 r, r) 174 | Fact (n, x = of_hex '63616665'; n == 4 & get0 x == 063 & get0 x+1 == 061 & get0 x+2 == 066 & get0 x+3 == 065) 175 | Fact (n, x = of_hex '63.61 66.65'; n == 4 & get0 x == 063 & get0 x+1 == 061 & get0 x+2 == 066 & get0 x+3 == 065) 176 | -------------------------------------------------------------------------------- /ref.m: -------------------------------------------------------------------------------- 1 | # reference, mutable 2 | 3 | https://en.wikipedia.org/wiki/Reference_type 4 | https://wiki.haskell.org/Mutable_variable 5 | https://en.wikipedia.org/wiki/Const_(computer_programming) 6 | http://en.wikipedia.org/wiki/Assignment_%28computer_science%29#Notation 7 | 8 | main x:0 : %0 = (y = Mem 8; Mem.set y x; Cast.any y) 9 | 10 | cast x:0 : %1 = Cast.any x 11 | 12 | mem x:%0 : Mem = Cast.any x 13 | 14 | nat x:%0 : N = Cast.any x 15 | 16 | get x:%0 : 0 = Mem.get x.mem . Cast.any 17 | Fact (get (main 42) == 42) 18 | Fact (! main 42 == 42) 19 | 20 | set x:%0 a:0 = Mem.set x.mem a 21 | Fact (x = main 13; set x 42; x.get == 42) 22 | 23 | tickz x:%N = set x x.get+1 24 | 25 | tick x:%N : N = (set x x.get+1; x.get) 26 | Fact (x = main 13; tick x == 14 & x.get == 14) 27 | 28 | tick0 x:%N : N = (y = x.get; set x y+1; y) 29 | Fact (x = main 13; tick0 x == 13 & x.get == 14) 30 | 31 | diff s:%N y:N : N = (x = s.get; set s y; y - x) 32 | Fact (x = main 3; diff x 5 == 2 & get x == 5) 33 | 34 | sub s:%N x:N = set s s.get-x 35 | Fact (x = main 5; sub x 2; x.get == 3) 36 | 37 | add s:%N x:N = set s s.get+x 38 | Fact (x = main 3; add x 5; x.get == 8) 39 | 40 | add1 s:%N = set s s.get+1 41 | Fact (x = main 3; add1 x; x.get == 4) 42 | 43 | addc s:%S = set s s.get+1 44 | Fact (x = main 'foo'; addc x; x.get == 'oo') 45 | 46 | seq_add s:%*0 x:0 = set s x,s.get 47 | Fact (x = main [3, 5]; seq_add x 2; x.get == [2, 3, 5]) 48 | 49 | 50 | # 51 | https://en.wikipedia.org/wiki/Compare-and-swap 52 | !x == old & (x new; x) | !x 53 | swap x:%0 old:0 new:0 : 0 = Asm # cmpxchg 54 | mov c sp 24 55 | mov a sp 16 # old 56 | mov di sp 8 # new 57 | 0f0 # lock 58 | cmpxchg c 0 di # cmpxchg x new 59 | mov sp 32 a 60 | ret 61 | Fact (x = %13; swap x 13 42 == 13 & !x == 42) 62 | Fact (x = %21; swap x 13 42 == 21 & !x == 21) 63 | 64 | # 65 | https://gcc.gnu.org/onlinedocs/gcc-4.2.1/gcc/Atomic-Builtins.html 66 | bool __sync_bool_compare_and_swap (type *ptr, type oldval type newval, ...) 67 | swap0 x:%0 old:0 new:0 : B = Asm # cmpxchg, swap0 x:%0 old:0 new:0 : B = !x == old & (x new; 1) | 0 68 | mov c sp 24 69 | mov a sp 16 # old 70 | mov di sp 8 # new 71 | 0f0 # lock 72 | cmpxchg c 0 di # cmpxchg x new 73 | mov a 0 # [set] sets/clears only the lower 8-bit 74 | set e a 75 | mov sp 32 a 76 | ret 77 | Fact (x = %13; swap0 x 13 42 & !x == 42) 78 | Fact (x = %21; swap0 x 13 42 . B.not & !x == 21) 79 | 80 | # parallel add by 1 81 | padd1 s:%N = (swap0 s !s !s+1 | padd1 s) # no need to [r = !s] 82 | Fact (s = %1; padd1 s; !s == 2) 83 | Fact (s = %0; f = (_ _:N = N.for 10_000 (_ _:N = padd1 s)); f 0; f 0; !s == 20_000) # serial run 84 | Fact (s = %0; f = (_ _:N = N.for 10_000 (_ _:N = padd1 s)); Thread.two f f; 1) # fixme - Mem.make too small in Thread.two - Bus error: 10 85 | 86 | # https://en.wikipedia.org/wiki/Fetch-and-add 87 | # parallel add 88 | padd s:%N x:N = (swap0 s !s !s+x | padd s x) # no need to [r = !s] 89 | Fact (s = %1; padd s 2; !s == 3) 90 | Fact (s = %0; f = (_ _:N = N.for 10_000 (_ _:N = padd s 2)); f 0; f 0; !s == 40_000) # serial run 91 | Fact (s = %0; f = (_ _:N = N.for 10_000 (_ _:N = padd s 2)); Thread.two f f; !s == 40_000) 92 | 93 | # 94 | http://www.ibm.com/developerworks/aix/library/au-multithreaded_structures2/ 95 | https://www.kernel.org/doc/Documentation/trace/ring-buffer-design.txt 96 | http://www.hpl.hp.com/techreports/2004/HPL-2004-105.pdf 97 | ppair x:0 s:%*0 = ! swap0 s !s x,!s & ppair x s 98 | Fact (s = %[13]; ppair 42 s; !s == [42, 13]) 99 | Fact (s = %[]; N.for 10 (_ i:N = ppair i s); !s == [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]) 100 | 101 | Fact 102 | s = %[] 103 | f = (_ _:N = (N.for 10000 ((_ s:%*N i:N = (Sys.cpuid 0; ppair i s)) s))) # Sys.cpuid for slowing to yield 104 | Thread.two_ready f f 105 | !s != List.add 10000.List.nat 10000.List.nat # should interleave, if start at the same time and scheduling is fair 106 | 107 | pop opt:0?!0 s:%*0 : !0 = (u = !s; u . (x,r? (swap0 s u r & opt x | pop opt s))) 108 | Fact (s = %[13]; pop N.opt s == N.opt 13 & pop N.opt s == 0) 109 | Fact 110 | r = 10000.List.nat 111 | s = %r; r1 = %[]; r2 = %[] 112 | # s = %r; r1 = %[] : %*N; r2 = %[] : %*N 113 | f = (_ s:%*N r:%*N _:N = (N.for 10000 ((_ s:%*N r:%*N _:N = (Sys.cpuid 0; x = pop N.opt s; x & r x.N.must,!r)) s r))) # cpuid to slow down for fair scheduling 114 | Thread.two_ready (f s r1) (f s r2) 115 | List.bit !r1 & List.bit !r2 & List.sole_by N.eq !r1 & List.sole_by N.eq !r2 & List.fuse !r1 !r2 == r.List.rev # in very rare (1/100k), scheduler may block one core, and this test fails 116 | 117 | do f:0?_ s:%*0 opt:0?!0 must:!0?0 = (x = pop opt s; x & (f x.must; do f s opt must)) 118 | Fact (s = %[2, 3]; r = %0; do (padd r) s N.opt N.must; !r == 5) 119 | 120 | lock x:%B = Asm # use pause/cpuid with jmp in assembly 121 | mov r8 sp 8 # cpuid overwrites a b c d 122 | mov a 0 # old 123 | mov di 1 # new 124 | @Ref.lock_0 125 | 0f0 # lock 126 | cmpxchg r8 0 di # cmpxchg x new 127 | j e Ref.lock_1 128 | mov a 0 # cmpxchg overwrites rax 129 | pause 130 | j Ref.lock_0 131 | @Ref.lock_1 132 | ret 133 | Fact (x = %0; lock x; !x) 134 | 135 | open x:%B = x 0 136 | Fact (x = %0; lock x; open x; !(!x)) 137 | -------------------------------------------------------------------------------- /kind.m: -------------------------------------------------------------------------------- 1 | # class of type 2 | 3 | https://en.wikipedia.org/wiki/Kind_(type_theory) 4 | 5 | _nat_seq = %0 : %*S # x = n 6 | _real_seq = %0 : %*S # x = r 7 | _tag_seq = %0 : %*S # X = n 8 | _type_seq = %0 : %*S,Type # X = t 9 | _exp_seq = %0 : %*S,Type # x = a : t 10 | _type_names = % 1.Set : % S/Z # X = t, updated in Kind.main via _exp_defs and _type_seq 11 | 12 | # todo - generalize to name-types 13 | name_nats = % 1.Set : % S/Z # x = n 14 | name_reals = % 1.Set : % S/Z # x = r 15 | 16 | name_tags = % 1.Set : % S/Z # X = n 17 | name_types = % 1.Hash : % S/Type # X = t 18 | name_funs = % 1.Hash : % S/(return:Type, args:Types) # f x0:t0 x1:t1 ... : t = a 19 | name_exps = % 1.Hash : % S/Type # x, t for x = a : t 20 | 21 | pre op:S x:Exp : Exp = x.Exp.spot, Pre op x 22 | 23 | op type:Type : *S = 24 | type.Exp.tree . 25 | Op o? [o] 26 | Pre o t? o, op t 27 | Binary t o u? op t + (o, op u) 28 | ? Exp.seq_error $Fun 'invalid' [type] 29 | 30 | unary x:S : B = List.in S.eq ['%', '!', '*'] x 31 | 32 | predefined x:S : B = List.in S.eq ['Any', 'Mem', 'File'] x | tag x 33 | 34 | tag x:S : B = List.in S.eq ['Term', 'Reg', 'Flag'] x # todo 35 | 36 | name : S ? Term = 37 | 'Z'? Z_ 38 | 'I'? I 39 | 'B'? B 40 | 'C'? C_ 41 | 'N0'? N0 42 | 'N1'? N1 43 | 'N2'? N2 44 | 'N'? N 45 | 'S'? S_ 46 | 'R'? R_ 47 | x? Name x 48 | Fact (name 'Z' . str == 'Z') 49 | Fact (name 'foo' . str == 'foo') 50 | 51 | # checking well-formedness of type def 52 | # !%t (! % t) -> (! (% t)) 53 | # !%!%t ((! % !) % t) -> (! (% (! (% t)))) 54 | # !!%t ((! !) % t) -> (! (! (% t))) 55 | # todo - check if the return type, if polymorphic, is contrained by the input type, except Cast.* 56 | of_type exp=spot,term:Type : Type = term . 57 | Name '_'? spot, Name 'Any' # diff? Any vs _ 58 | Name 'Z'? spot, Z_ 59 | Name 'I'? spot, I 60 | Name 'B'? spot, B 61 | Name 'C'? spot, C_ 62 | Name 'N0'? spot, N0 63 | Name 'N1'? spot, N1 64 | Name 'N2'? spot, N2 65 | Name 'N'? spot, N 66 | Name 'S'? spot, S_ 67 | Name 'R'? spot, R_ 68 | Name x & (predefined x | Set.in S.eq !_type_names x)? exp 69 | Tnat _? exp # for testing only? 70 | Nat _? exp 71 | Pre o t & List.in S.eq ['+', '*', '!', '%'] o? spot, Pre o t.of_type # seq list opt ref 72 | Post t o & List.in S.eq ['^'] o? spot, Post t.of_type o # row 73 | Binary t o u & unary o? of_type (List.sum_right (t.op + [o]) pre u) # % * 0 -> (% (* 0)) 74 | Binary t o u & List.in S.eq ['^', '?', '-', '/', '~'] o? spot, Binary t.of_type o u.of_type # row, fun, map, hash, tree 75 | Binary x ':' t? spot, Binary x ':' t.of_type # key 76 | Row s? spot, Row_ (s of_type) 77 | Tree (_, Name 'Tag') s? spot, Name !Tag.name 78 | Tree s? spot, Tree (s of_type) # todo - check arity 79 | ? Exp.seq_error $Fun 'invalid' [exp] 80 | Fact (Exp.eq1 (of_type (Exp.of '!!S')) (Pre '!' (Spot.nil, Pre '!' (Spot.nil, S_)))) 81 | 82 | _exp_defs : Exp? Z = 83 | _, Binary (spot, Name name) '=' (_, Binary body ':' type)? # x = a : t 84 | Ref.seq_add _exp_seq (Type.name_full spot name),type 85 | _, Binary (spot, Name name) '=' body? body.Exp.tree . # 86 | Nat _? Ref.seq_add (S.is_capital name & _tag_seq | _nat_seq) (Type.name_full spot name) # x = n, X = n 87 | Real _? Ref.seq_add _real_seq (Type.name_full spot name) # x = r 88 | _ & S.is_capital name? Ref.seq_add _type_seq (name, body) # X = t 89 | a? Exp.seq_error $Fun 'invalid' [(spot, a)] 90 | 91 | arg_bind : Exp? S, Type = # x:t or x=a:t -> x:t 92 | _, Binary (_, Name x) ':' t? x, t.of_type 93 | _, Binary (_, Name x) '=' (_, Binary _ ':' t)? x, t.of_type 94 | a? Exp.seq_error $Fun 'invalid' [a] 95 | 96 | _fun_arg_type : Exp? S, Type = 97 | spot, Binary (spot2, Name x) ':' t? x, (spot, Binary (spot2, Name x) ':' t.of_type) 98 | spot, Binary (spot2, Name x) '=' (spot3, Binary a ':' t)? x, (spot, Binary (spot2, Name x) '=' (spot3, Binary a ':' t.of_type)) 99 | a? Exp.seq_error $Fun 'invalid' [a] 100 | 101 | _fun_type : Exp? *(S, Type,Types) = # return type, argument types 102 | spot, Binary (_, Binary (_, Tree (_, Name name),args) ':' return) '=' _? # function definition - f x:t.. : t = a 103 | arg_types = List.map (List.map args _fun_arg_type) Row.at1 # Type.TODO_MAX_ARG 104 | [(Type.name_full spot name, (of_type return, arg_types))] 105 | 106 | main exps:Exps = 107 | List.do exps _exp_defs 108 | name_nats (!_nat_seq).List.set # x = n 109 | name_reals (!_real_seq).List.set # x = r 110 | name_tags (!_tag_seq).List.set # X = n 111 | _type_names (Map.key_set !_type_seq) 112 | name_types (Map.map1 of_type !_type_seq . List.hash) # after updating _type_names above 113 | name_funs (List.map_add exps _fun_type . List.hash) 114 | name_exps (Map.map1 of_type !_exp_seq).List.hash 115 | 116 | of x:S : Type = x.Exp.type_of.of_type 117 | Fact (Exp.eq1 (of 'S') S_) 118 | Fact (Exp.eq1 (of '"42"') (Tnat 42)) 119 | -------------------------------------------------------------------------------- /n.m: -------------------------------------------------------------------------------- 1 | # nat, non-negative natural number, unsigned integer 2 | 3 | http://en.wikipedia.org/wiki/Natural_number 4 | https://en.wikipedia.org/wiki/Integer_(computer_science)#Long_long 5 | http://danluu.com/integer-overflow/# The Performance Cost of Integer Overflow Checking 6 | 7 | add x:N y:N : N = Asm 8 | mov a sp 16 9 | mov c sp 8 10 | add a c 11 | mov sp 24 a 12 | ret 13 | 14 | sub x:N y:N : N = Asm 15 | mov a sp 16 16 | mov c sp 8 17 | sub a c 18 | mov sp 24 a 19 | ret 20 | 21 | mul x:N y:N : N = Asm 22 | mov a sp 16 23 | mul sp 8 24 | mov sp 24 a 25 | ret 26 | 27 | div x:N y:N : N = Asm 28 | mov a sp 16 29 | mov d 0 30 | div sp 8 31 | mov sp 24 a 32 | ret 33 | 34 | mod x:N y:N : N = Asm 35 | mov a sp 16 36 | mov d 0 37 | div sp 8 38 | mov sp 24 d 39 | ret 40 | 41 | or x:N y:N : N = Asm 42 | mov a sp 16 43 | mov c sp 8 44 | or a c 45 | mov sp 24 a 46 | ret 47 | 48 | and x:N y:N : N = Asm 49 | mov a sp 16 50 | mov c sp 8 51 | and a c 52 | mov sp 24 a 53 | ret 54 | 55 | shl x:N y:N : N = Asm 56 | mov a sp 16 57 | mov c sp 8 58 | shl a 59 | mov sp 24 a 60 | ret 61 | 62 | shl32 x:N : N = Asm 63 | mov a sp 8 64 | shl a 32 65 | mov sp 16 a 66 | ret 67 | 68 | shr x:N y:N : N = Asm 69 | mov a sp 16 70 | mov c sp 8 71 | shr a 72 | mov sp 24 a 73 | ret 74 | 75 | eq x:N y:N : B = Asm 76 | mov a sp 16 77 | cmp a sp 8 78 | mov c 0 79 | set e c 80 | mov sp 24 c 81 | ret 82 | 83 | ne x:N y:N : B = Asm 84 | mov a sp 16 85 | cmp a sp 8 86 | mov c 0 87 | set ne c 88 | mov sp 24 c 89 | ret 90 | 91 | gt x:N y:N : B = Asm 92 | mov a sp 16 93 | cmp a sp 8 94 | mov c 0 95 | set g c 96 | mov sp 24 c 97 | ret 98 | 99 | ge x:N y:N : B = Asm 100 | mov a sp 16 101 | cmp a sp 8 102 | mov c 0 103 | set ge c 104 | mov sp 24 c 105 | ret 106 | 107 | lt x:N y:N : B = Asm 108 | mov a sp 16 109 | cmp a sp 8 110 | mov c 0 111 | set l c 112 | mov sp 24 c 113 | ret 114 | 115 | le x:N y:N : B = Asm 116 | mov a sp 16 117 | cmp a sp 8 118 | mov c 0 119 | set le c 120 | mov sp 24 c 121 | ret 122 | 123 | neg x:N : N = Asm 124 | mov a sp 8 125 | neg a 126 | mov sp 16 a 127 | ret 128 | 129 | char x:N : C = Cast.nat_char x 130 | 131 | bit x:N : B = Cast.bit x 132 | 133 | str_rev x:N y:S = x & (S.set y (x % 10 + \0).char; str_rev x/10 y+1) 134 | str x:N : S = (y = S.new 20; x & (str_rev x y; S.rev y) | (S.set y \0; y)) 135 | Fact (str 42 == '42') 136 | Fact (str \a == 'a') 137 | Fact (N.str \a == '97') 138 | Fact (str 3141592653589793238 == '3141592653589793238') 139 | 140 | str_pure x:N : S = (y = S.new 20; x & (str_rev x y; S.rev_pure y) | (S.set y \0; y)) 141 | Fact (str_pure 42 == '42') 142 | Fact (str_pure \a == '97') 143 | Fact (str_pure 3141592653589793238 == '3141592653589793238') 144 | 145 | str3 x:N : S = str x . S.div3 146 | Fact (str3 3141592653589793238 == '3_141_592_653_589_793_238') 147 | 148 | of1 a:N b:N : N = or (shl a 8) b 149 | Fact (of1 0ca 0fe == 0cafe) 150 | 151 | of2 a:N b:N c:N d:N : N = or (shl (of1 a b) 16) (of1 c d) 152 | Fact (of2 0ca 0fe 0ba 0be == 0cafe_babe) 153 | 154 | of3 a:N b:N c:N d:N e:N f:N g:N h:N : N = or (shl (of2 a b c d) 32) (of2 e f g h) 155 | Fact (of3 0ca 0fe 0ba 0be 0de 0ad 0be 0ef == 0cafe_babe_dead_beef) 156 | 157 | str5 x:N : S = (y = x.str; S.heads y+' ' 5) 158 | 159 | put x:N = x.str.Put 160 | err x:N = x.str.Err 161 | log x:N = x.str.Log 162 | write file:File x:N = File.write file x.str 163 | linef file:File x:N = File.line file x.str 164 | 165 | between a:N x:N b:N : B = a <= x & x <= b 166 | Fact (between 13 29 42) 167 | Fact !(between 42 13 29) 168 | 169 | min x:N y:N : N = x < y & x | y 170 | Fact (min 0 42 == 0) 171 | Fact (min 13 42 == 13) 172 | 173 | max x:N y:N : N = x < y & y | x 174 | Fact (max 0 42 == 42) 175 | Fact (max 42 13 == 42) 176 | 177 | rank x:N : N = 178 | | x <= 0ff & 0 179 | | x <= 0ffff & 1 180 | | x <= 0ffff_ffff & 2 181 | | 3 182 | Fact (rank 42 == 0) 183 | Fact (rank 0cafe == 1) 184 | Fact (rank 0cafe_babe == 2) 185 | Fact (rank 0cafe_babe_dead_beef == 3) 186 | 187 | at x:N shift:N : N = and (shr x shift) 0ff 188 | Fact (at 0cafe_babe_dead_beef 16 == 0ad) 189 | 190 | for n:N f:N?0 i=0:N = i < n & (f i; for n f i+1) 191 | _fact_sum = %0 : %N 192 | Fact (for 10 (_ x:N = Ref.add _fact_sum x); !_fact_sum == 45) 193 | 194 | for2 n:N f:0?N?Z x:0 i=0:N = i < n & (f x i; for2 n f x i+1) 195 | _fact_sum2 = %0 : %N 196 | Fact (for2 10 (_ a:N x:N = Ref.add _fact_sum2 a+x) 1; !_fact_sum2 == 55) 197 | 198 | any f:N?B n:N i=0:N : !N = i < n & (f i & opt i | any f n i+1) 199 | Fact (any (_ x:N : B = 5*x > 42) 10 == opt 9) 200 | 201 | do n:N f:Z?Z = n > 0 & (f 0; do n-1 f) 202 | _fact_do_sum = %0 : %N 203 | Fact (do 10 (? Ref.tickz _fact_do_sum); !_fact_do_sum == 10) 204 | 205 | add3 x:N y:N z:N : N = x + y + z 206 | 207 | even x:N : B = x % 2 == 0 208 | 209 | odd x:N : B = x % 2 == 1 210 | 211 | mod2 x:N y:N : B = x % 2 == y % 2 212 | 213 | mod2_ne x:N y:N : B = x % 2 != y % 2 # !mod2 214 | 215 | tick x:N : N = x + 1 216 | 217 | div0 x:N y:N : N = y & x / y 218 | 219 | sub2 y:N x:N : N = x - y 220 | 221 | map n:N f:N?0 : *0 = n & f n-1, map n-1 f 222 | Fact (map 3 Fun.id == [2, 1, 0]) 223 | 224 | # https://developer.apple.com/library/mac/documentation/Darwin/Reference/ManPages/man3/rand.3.html int rand(void); 225 | lib_rand = Dl'rand' : Z? N 226 | 227 | rand _ : N = Fun.call0 lib_rand 228 | 229 | pick n:N : N = 0.rand % n # RAND_MAX = 2147483647 = 0x7fffffff, 31-bit 230 | Fact (pick 13 <= 13) 231 | 232 | hex1 x:C : N = between \a x \f & x - \a + 10 | x - \0 233 | Fact (hex1 \d == 13) 234 | 235 | or3 x:N y:N z:N : N = or (or x y) z 236 | or4 x:N y:N z:N w:N : N = or (or (or x y) z) w 237 | 238 | bytes : N ? N = 239 | 0? 1 240 | 1? 2 241 | 2? 4 242 | 3? 8 243 | n? Fail.main2 $Fun n.N.str 244 | 245 | max3 = 0ffff_ffff_ffff_ffff 246 | 247 | ip x:N : S = S.fill '$n.$n.$n.$n' [N.at x 0, N.at x 8, N.at x 16, N.at x 24] 248 | 249 | real x:N : R = Cast.bits_real x 250 | 251 | str_size = 20 # 2^64 = 18446744073709551616 252 | 253 | opt x:N : !N = Cast.any (x + 1) 254 | 255 | must x:!N : N = Cast.nat x - 1 256 | -------------------------------------------------------------------------------- /packs.m: -------------------------------------------------------------------------------- 1 | # machine data 2 | z # zero, void, nil, null, unit 3 | b # bit, bool, boolean, flag, truth, logic 4 | c # char, character, unicode code point 5 | n # nat, number, non-negative, unsigned 6 | i # int, integer, signed, natural number 7 | r # real, floating-point number 8 | 9 | # interpreted data 10 | any # abstract data 11 | hex # hexadecimal number 12 | mem # memory address, pointer 13 | unicode # universal character set 14 | fun # function, procedure, routine 15 | 16 | # structured data 17 | opt # optional, nullable, some, pointed 18 | pair # two data, product, cons 19 | ref # reference, mutable 20 | row # array, tuple, vector, product 21 | s # str, string, character array 22 | list # singly linked list 23 | seq # sequence, container, collection, generator 24 | box # packed data, inlined 25 | key # named, label, struct, record 26 | map # finite map, association, dictionary, finite function 27 | hash # hashtable, mutable and unordered map 28 | set # mathematical set 29 | flow # stream, buffer, port 30 | regex # regular expression, character pattern 31 | 32 | # hardware 33 | core # cpu, multi processor, hyperthread 34 | spin # concurrency synchronization lock 35 | clock # timer, frequency tick 36 | 37 | # operating system 38 | sys # system call, kernel call 39 | posix # portable operating system interface 40 | dl # dynamic linking loader, dynamic library 41 | job # unix job, process 42 | thread # system-mode parallelism 43 | task # user-mode parallelism, coroutine 44 | time # calendar, date and time, epoch 45 | env # environment, context 46 | 47 | # langauge 48 | cast # type cast, coercion 49 | fail # fatal exit, abort, exception, error 50 | fact # assert, check, test 51 | trap # signal, interrupt, fault 52 | call # call stack, stack trace 53 | perf # performance, profile, monitor 54 | main # top level, entry point, program start 55 | 56 | # file system 57 | path # unix file path, file name 58 | file # unix file description / number / handler 59 | pipe # unix pipeline, process input/output chain 60 | in # file 0, standard input 61 | out # file 1, standard output 62 | put # file 1, standard output, with newline 63 | err # file 2, standard error 64 | log # file 2, standard error, with newline 65 | info # file 4, informational output 66 | trace # file 5, performance time tracing 67 | debug # file 6, verbose debugging diagnostic 68 | 69 | # network 70 | socket # network file 71 | net # network address, ip address, host identification 72 | openssl # secure sockets layer 73 | common_crypto # common crypto in mac os x 74 | http # hypertext transfer protocol 75 | httpd # hypertext transfer protocol daemon, web server 76 | 77 | # library 78 | json # javascript object notation 79 | zlib # compression via gzip 80 | blas # basic linear algebra subprograms 81 | dbm # unix simple database 82 | sqlite # sql database engine 83 | cocoa # cocoa ui in mac os x 84 | quant # quantitative analysis 85 | dynamodb # amazon cloud key-value database 86 | 87 | # compiler 88 | spot # file position, path and line and column 89 | tag # tagged union, enum, algebraic data type 90 | name # identifier, unique string, naming convention 91 | op # symbolic operator, prefix/infix/suffix function 92 | meta # reflection, string interpolation 93 | term # token, node, word, lexical form 94 | exp # expression, tree, phrase, parser form 95 | group # delimited, lexical sub-term by line / limit / glue / associate 96 | rule # rewrite rule, pattern matching 97 | rewrite # tree rewrite 98 | kind # class of type 99 | unify # constraint resolve 100 | def # definition, equality 101 | type # class of term 102 | step # opcode, linear computation, flat execution 103 | asm # assembly, machine code 104 | -------------------------------------------------------------------------------- /row.m: -------------------------------------------------------------------------------- 1 | # array, tuple, vector 2 | 3 | https://en.wikipedia.org/wiki/Tuple 4 | https://en.wikipedia.org/wiki/Array_data_type 5 | https://en.wikipedia.org/wiki/Row_(database) 6 | 7 | new1 x:0 : Mem = (s = Mem 8; Mem.set s x; Cast.any s) 8 | new2 x:0 y:1 : 0, 1 = (s = Mem 16; Mem.set s x; Mem.set s+8 y; Cast.any s) 9 | new3 x:0 y:1 z:2 : 0, 1, 2 = (s = Mem 24; Mem.set s x; Mem.set s+8 y; Mem.set s+16 z; Cast.any s) 10 | new4 x:0 y:1 z:2 w:3 : 0, 1, 2, 3 = (s = Mem 32; Mem.set s x; Mem.set s+8 y; Mem.set s+16 z; Mem.set s+24 w; Cast.any s) 11 | new5 x:0 y:1 z:2 w:3 u:4 : 0, 1, 2, 3, 4 = (s = Mem 40; Mem.set s x; Mem.set s+8 y; Mem.set s+16 z; Mem.set s+24 w; Mem.set s+32 u; Cast.any s) 12 | new6 x:0 y:1 z:2 w:3 u:4 v:5 : 0, 1, 2, 3, 4, 5 = (s = Mem 48; Mem.set s x; Mem.set s+8 y; Mem.set s+16 z; Mem.set s+24 w; Mem.set s+32 u; Mem.set s+40 v; Cast.any s) 13 | new7 x:0 y:1 z:2 w:3 u:4 v:5 p:6 : 0, 1, 2, 3, 4, 5, 6 = (s = Mem 56; Mem.set s x; Mem.set s+8 y; Mem.set s+16 z; Mem.set s+24 w; Mem.set s+32 u; Mem.set s+40 v; Mem.set s+48 p; Cast.any s) 14 | new8 x:0 y:1 z:2 w:3 u:4 v:5 p:6 q:7 : 0, 1, 2, 3, 4, 5, 6, 7 = (s = Mem 64; Mem.set s x; Mem.set s+8 y; Mem.set s+16 z; Mem.set s+24 w; Mem.set s+32 u; Mem.set s+40 v; Mem.set s+48 p; Mem.set s+56 q; Cast.any s) 15 | 16 | getx s:Mem : 0 = Mem.get s . Cast.any 17 | get s:0^ i:N : 1 = Mem.get (s.Mem.of + i*8) . Cast.any 18 | 19 | mem s:0^ : Mem = Cast.any s 20 | 21 | get0 s:0^ : 0 = Mem.get s.Mem.of . Cast.any 22 | get1 s:0^ : 1 = Mem.get (s.Mem.of + 1*8) . Cast.any 23 | get2 s:0^ : 2 = Mem.get (s.Mem.of + 2*8) . Cast.any 24 | get3 s:0^ : 3 = Mem.get (s.Mem.of + 3*8) . Cast.any 25 | get4 s:0^ : 4 = Mem.get (s.Mem.of + 4*8) . Cast.any 26 | get5 s:0^ : 5 = Mem.get (s.Mem.of + 5*8) . Cast.any 27 | 28 | at0 s:0,1 : 0 = Mem.get s.Mem.of . Cast.any 29 | at1 s:0,1 : 1 = Mem.get (s.Mem.of + 1*8) . Cast.any 30 | at2 s:0,1,2 : 2 = Mem.get (s.Mem.of + 2*8) . Cast.any 31 | at3 s:0,1,2,3 : 3 = Mem.get (s.Mem.of + 3*8) . Cast.any 32 | at4 s:0,1,2,3,4 : 4 = Mem.get (s.Mem.of + 4*8) . Cast.any 33 | at5 s:0,1,2,3,4,5 : 5 = Mem.get (s.Mem.of + 5*8) . Cast.any 34 | 35 | name n:N i:N : Term = Name2 'Row' ('at' + n.N.str + '_' + i.N.str) 36 | 37 | Fact (at0 13,'foo' == 13) 38 | Fact (at1 13,'foo' == 'foo') 39 | 40 | at2_0 s:0,1 : 0 = Mem.get s.Mem.of . Cast.any 41 | at3_0 s:0,1,2 : 0 = Mem.get s.Mem.of . Cast.any 42 | at4_0 s:0,1,2,3 : 0 = Mem.get s.Mem.of . Cast.any 43 | at5_0 s:0,1,2,3,4 : 0 = Mem.get s.Mem.of . Cast.any 44 | at6_0 s:0,1,2,3,4,5 : 0 = Mem.get s.Mem.of . Cast.any 45 | 46 | at2_1 s:0,1 : 1 = Mem.get (s.Mem.of + 1*8) . Cast.any 47 | at3_1 s:0,1,2 : 1 = Mem.get (s.Mem.of + 1*8) . Cast.any 48 | at4_1 s:0,1,2,3 : 1 = Mem.get (s.Mem.of + 1*8) . Cast.any 49 | at5_1 s:0,1,2,3,4 : 1 = Mem.get (s.Mem.of + 1*8) . Cast.any 50 | at6_1 s:0,1,2,3,4,5 : 1 = Mem.get (s.Mem.of + 1*8) . Cast.any 51 | 52 | at3_2 s:0,1,2 : 2 = Mem.get (s.Mem.of + 2*8) . Cast.any 53 | at4_2 s:0,1,2,3 : 2 = Mem.get (s.Mem.of + 2*8) . Cast.any 54 | at5_2 s:0,1,2,3,4 : 2 = Mem.get (s.Mem.of + 2*8) . Cast.any 55 | at6_2 s:0,1,2,3,4,5 : 2 = Mem.get (s.Mem.of + 2*8) . Cast.any 56 | 57 | at4_3 s:0,1,2,3 : 3 = Mem.get (s.Mem.of + 3*8) . Cast.any 58 | at5_3 s:0,1,2,3,4 : 3 = Mem.get (s.Mem.of + 3*8) . Cast.any 59 | at6_3 s:0,1,2,3,4,5 : 3 = Mem.get (s.Mem.of + 3*8) . Cast.any 60 | 61 | at5_4 s:0,1,2,3,4 : 4 = Mem.get (s.Mem.of + 4*8) . Cast.any 62 | at6_4 s:0,1,2,3,4,5 : 4 = Mem.get (s.Mem.of + 4*8) . Cast.any 63 | 64 | at6_5 s:0,1,2,3,4,5 : 5 = Mem.get (s.Mem.of + 5*8) . Cast.any 65 | 66 | main n:N : Mem = Mem 8*n 67 | 68 | at s:Mem i:N : N = Mem.get (s + Box.size*i) 69 | atx s:0^ i:N : 0 = Mem.get (s.mem + Box.size*i) . Cast.any 70 | Fact (s = 13,42 . Cast.any; at s 1 == 42) 71 | Fact (s = 13,42 : N^; atx s 1 == 42) 72 | 73 | set s:Mem i:N x:Mem = Mem.set (s + 8*i) x 74 | setx s:0^ i:N x:N = Mem.set (s.mem + 8*i) x 75 | 76 | of_atx s:*0 r:0^ = s & (Mem.set r.mem s.List.head; of_atx s.List.tail (off_by r 8)) 77 | of_at s:*0 r:Mem = s & (Mem.set r s.List.head; of_at s.List.tail r+8) 78 | 79 | of s:*0 : 1 = (r = Mem 8*s.List.size . Cast.any; of_at s r; Cast.any r) # [x,..] -> (x,..) 80 | 81 | Fact (s = new2 2 3; [s.at2_0, s.at2_1] == [2, 3]) 82 | Fact (s = new3 2 3 5; [s.at0, s.at1, s.at2] == [2, 3, 5]) 83 | Fact (s = new4 2 3 5 8; [s.at0, s.at1, s.at2, s.at3] == [2, 3, 5, 8]) 84 | Fact (s = new5 2 3 5 8 13; [s.at0, s.at1, s.at2, s.at3, s.at4] == [2, 3, 5, 8, 13]) 85 | Fact (s = new6 2 3 5 8 13 21; [s.at0, s.at1, s.at2, s.at3, s.at4, s.at5] == [2, 3, 5, 8, 13, 21]) 86 | 87 | byte : Type ? N = 88 | _, N0? 1 89 | _, N1? 2 90 | _, N2? 4 91 | ? 8 92 | 93 | rank : Type ? N = 94 | _, N0? 0 95 | _, N1? 1 96 | _, N2? 2 97 | ? 3 98 | 99 | bytes s:Types : N = List.map_sum_nat s byte 100 | Fact (byte 'N0'.Type.of_str2 == 1) 101 | Fact (byte 'N0,N'.Type.of_str2 == 8) # todo boxed, 9 102 | Fact (byte 'N0,(N1,N2),N,B'.Type.of_str2 == 8) # unboxed, 23 103 | 104 | of_exp_set spot:Spot name:Exp base:N exp:Exp type:Type : N, Exp = 105 | mem = spot, Tree [(spot, Name2 'N' 'add'), name, (spot, Nat base)] 106 | base + byte type, (spot, Tree [(spot, Name2 'Mem' 'set'), mem, exp]) 107 | 108 | of_exp3 exp:Exp : Exp = # 64-bit 109 | spot = Exp.spot exp 110 | spot, Row_ [(spot, Nat 3), exp] 111 | 112 | of_exp2 exp:Exp type:Type : Exp = 113 | spot = Exp.spot exp 114 | spot, Row_ [(spot, Nat type.rank), exp] 115 | 116 | of_exps2 spot:Spot exps:Exps types:Types : Exp = 117 | spot, Tree ((spot, Name 'Row'), ((spot, Nat types.bytes), List.map2 exps types of_exp2)) 118 | 119 | of_exps3 spot:Spot exps:Exps : Exp = 120 | spot, Tree ((spot, Name 'Row'), ((spot, Nat (8 * exps.List.size)), List.map exps of_exp3)) 121 | 122 | #Fact ((0d:N0, 02a:N1, 0a:N0).0 == 0a002a0d) # fixme 123 | 124 | off s:Mem : Mem = Mem.off s Box.size 125 | offx s:0^ : 0^ = Mem.off s.mem Box.size . Cast.any 126 | off_by s:0^ i:N : 0^ = Mem.off s.mem i*Box.size . Cast.any 127 | 128 | for f:0?1 s:Mem n:N = n & (Mem.set s s.Mem.get.f; for f s.off n-1) # lenient return type, s[i] = f s[i] 129 | forx f:0?1 s:0^ n:N = n & (Mem.set s.mem s.get0.f; forx f s.offx n-1) # lenient return type, s[i] = f s[i] 130 | Fact (s = 13,42; for N.tick s.Mem.of 2; s.0 == 14 & s.1 == 43) 131 | 132 | do f:0?1 s:Mem n:N = n & (s.getx.f; do f s.off n-1) 133 | dox f:0?1 s:0^ n:N = n & (s.get0.f; dox f s.offx n-1) 134 | Fact (x = %0; do (Ref.add x) (row3 2,3,5) 3; !x == 10) 135 | 136 | eq r:Mem s:Mem n:N : B = Mem.eq r s n*Box.size 137 | eqx r:0^ s:0^ n:N : B = Mem.eq r.mem s.mem n*Box.size 138 | mem_eq3 r:0,1,2 s:Mem : B = eq r.Mem.of s 3 139 | mem_eq5 r:0,1,2,3,4 s:Mem : B = eq r.Mem.of s 5 140 | 141 | eq_by3 eq0:0?0?B eq1:1?1?B eq2:2?2?B a,b,c:0,1,2 x,y,z:0,1,2 : B = eq0 a x & eq1 b y & eq2 c z 142 | ne_by3 ne0:0?0?B ne1:1?1?B ne2:2?2?B a,b,c:0,1,2 x,y,z:0,1,2 : B = ne0 a x | ne1 b y | ne2 c z 143 | Fact (5,7,13 . eq_by3 N.eq N.eq N.eq 5,7,13) 144 | Fact !(5,7,13 . eq_by3 N.eq N.eq N.eq 5,7,42) 145 | Fact ('foo',5,7 . eq_by3 S.eq N.eq N.eq 'foo',5,7) 146 | Fact !('foo',5,7 . eq_by3 S.eq N.eq N.eq 'foo',42,7) 147 | 148 | eq_by4 eq0:0?0?B eq1:1?1?B eq2:2?2?B eq3:3?3?B a,b,c,d:0,1,2,3 x,y,z,w:0,1,2,3 : B = eq0 a x & eq1 b y & eq2 c z & eq3 d w 149 | eq_by5 eq0:0?0?B eq1:1?1?B eq2:2?2?B eq3:3?3?B eq4:4?4?B a,b,c,d,e:0,1,2,3,4 x,y,z,w,u:0,1,2,3,4 : B = eq0 a x & eq1 b y & eq2 c z & eq3 d w & eq4 e u 150 | eq_by6 eq0:0?0?B eq1:1?1?B eq2:2?2?B eq3:3?3?B eq4:4?4?B eq5:5?5?B a,b,c,d,e,f:0,1,2,3,4,5 x,y,z,w,u,v:0,1,2,3,4,5 : B = eq0 a x & eq1 b y & eq2 c z & eq3 d w & eq4 e u & eq5 f v 151 | 152 | # FIXME Rewrite.NAME_BUG 153 | str_by3 f:0?S g:1?S h_:2?S x,y,z:0,1,2 : S = f x + ',' + g y + ',' + h_ z 154 | Fact (str_by3 N.str S.str N.str 13,'foo',42 == '13,foo,42') 155 | Fact (str_by3 N.str S.str (Pair.str_by S.str N.str) 13,'foo',('bar',42) == '13,foo,bar,42') 156 | 157 | str_by4 f:0?S g:1?S h_:2?S i_:3?S x,y,z,w:0,1,2,3 : S = f x + ',' + g y + ',' + h_ z + ',' + i_ w 158 | str_by5 f:0?S g:1?S h_:2?S i_:3?S j_:4?S x,y,z,w,v:0,1,2,3,4 : S = f x + ',' + g y + ',' + h_ z + ',' + i_ w + ',' + j_ v 159 | str_by6 f:0?S g:1?S h_:2?S i_:3?S j_:4?S k_:5?S x,y,z,w,v,p:0,1,2,3,4,5 : S = f x + ',' + g y + ',' + h_ z + ',' + i_ w + ',' + j_ v + ',' + k_ p 160 | 161 | Fact (5,7,13 == 5,7,13) 162 | Fact !(5,7,13 == 5,7,42) 163 | Fact ('foo',5,7 == 'foo',5,7) 164 | Fact ('foo',5,7 != 'bar',5,7) 165 | Fact (5,7,13,'foo',21 == 5,7,13,'foo',21) 166 | Fact (5,7,13,'foo',21,'bar' == 5,7,13,'foo',21,'bar') 167 | 168 | Fact (str 'foo',42,'bar' == 'foo,42,bar') 169 | Fact (str 2,3,5,7 == '2,3,5,7') 170 | Fact (str 'foo',5,'bar',7,13 == 'foo,5,bar,7,13') 171 | Fact (str 'foo',5,'bar',7,13,21 == 'foo,5,bar,7,13,21') 172 | 173 | init n:N : Mem, 0?Z = 174 | s = main n 175 | i = %0 176 | s, (_ s_:Mem n_:N i_:%N x:0 = (!i_ < n_ | Fail.fill '$s - $h expect $n but $n' [$Fun, s_, n_, !i_]; set s_ !i_ x; Ref.add1 i_)) s n i 177 | #s, (_ s_:Mem n_:N i_:%N x:0 = (!i_ < n_ | (Mem.get0 0.Cast.any; Fail.fill '$s - $h expect $n but $n' [$Fun, s_, n_, !i_]); set s_ !i_ x; Ref.add1 i_)) s n i 178 | Fact (s, f = init 2; f 13; f 42; at s 0 == 13 & at s 1 == 42) 179 | Fact (Job.err ?(s, f = init 1; f 0; f 0; 0) . Regex "Row.f.* - .* expect 1 but 1\.") 180 | 181 | fold f:0?1?1 a:1 s:Mem n:N : 1 = (x = f (at s n-1) a; n > 1 & fold f x s n-1 | x) 182 | foldx f:0?1?1 a:1 s:0^ n:N : 1 = (x = f (atx s n-1) a; n > 1 & foldx f x s n-1 | x) 183 | Fact (fold N.add 0 (row3 2,3,5) 3 == 10) 184 | Fact (fold List.main 0 (row3 2,3,5) 3 == [2, 3, 5]) 185 | 186 | sum f:1?0?1 a:1 s:Mem n:N : 1 = n & sum f (f a s.getx) s.off n-1 | a 187 | sumx f:1?0?1 a:1 s:0^ n:N : 1 = n & sumx f (f a s.get0) s.offx n-1 | a 188 | Fact (sum N.add 0 (row3 2,3,5) 3 == 10) 189 | 190 | row3 s:0,0,0 : Mem = s.Cast.any 191 | row3x s:0,0,0 : 0^ = s.Cast.any 192 | -------------------------------------------------------------------------------- /group.m: -------------------------------------------------------------------------------- 1 | # delimited, lexical sub-term, glue / associate 2 | 3 | http://en.wikipedia.org/wiki/Indent_style 4 | 5 | rev_exps_trees spot:!Spot rev_exps:Exps trees:Exps : Exps = 6 | | rev_exps & 7 | | rev_exps.List.tail & 8 | exps = List.rev rev_exps 9 | ((spot | Exp.spot2 exps.List.head rev_exps.List.head), Tree exps), trees 10 | | 11 | x = rev_exps.List.head 12 | (spot & (spot, x.Exp.tree) | x), trees # singleton tree 13 | | trees # empty tree 14 | 15 | # f [] = 0 16 | # f [a] = a 17 | # f [b, a] s = Tree (;, a, b) 18 | # f [c, b, a] = Tree (;, a, (;, b, c)) 19 | # : Term 20 | rev_exps_op_semi rev_exps:Exps : !Exp = 21 | | rev_exps & 22 | | rev_exps.List.tail & 23 | spot, tree = rev_exps.List.head 24 | spot, Tree [(spot, tree), (spot, Op ';'), rev_exps_op_semi rev_exps.List.tail] 25 | | rev_exps.List.head 26 | 27 | # add rev seq of exps as a sequence of steps to trees of exps 28 | # f [] s = s 29 | # f [a] s = a, s 30 | # f [b, a] s = Tree (;, a, b), s 31 | # f [c, b, a] s = Tree (;, a, (;, b, c)), s 32 | # : Exp 33 | rev_exps_steps rev_exps:Exps trees:Exps : Exps = 34 | exp = rev_exps_op_semi rev_exps.List.rev 35 | | exp & exp, trees 36 | | trees # empty tree 37 | 38 | exps_trees_at space:N line_exps:Exps block_trees:Exps : Exps ? Exps, Exps = 39 | (spot, Level space0), exps? 40 | | (_, Level _? 1) exps.List.opt0 & # skip consecutive newlines 41 | exps_trees_at space line_exps block_trees exps 42 | 43 | | space0 < space & # pop, keep exps.head to keep popping 44 | #Type.log ((rev_exps_trees 0 line_exps block_trees).List.rev, ((spot, Level space0), exps)) 45 | #Type.log ((spot, Level space0), exps) 46 | (rev_exps_trees 0 line_exps block_trees).List.rev, ((spot, Level space0), exps) 47 | 48 | | space0 > space & # sub-block 49 | block, exps2 = exps_trees_at space0 0 0 exps 50 | | space0 == space + 1 & # arguments 51 | exps_trees_at space block.List.rev+line_exps block_trees exps2 52 | | # space0 == space + 2 # steps 53 | exps_trees_at space (rev_exps_steps block.List.rev line_exps) block_trees exps2 54 | 55 | | # space0 == space & 56 | exps_trees_at space0 0 (rev_exps_trees 0 line_exps block_trees) exps # same line 57 | 58 | exp, exps? exps_trees_at space (exp, line_exps) block_trees exps 59 | 60 | ? (rev_exps_trees 0 line_exps block_trees).List.rev, [] # line_exps == 0 if there's a trailing newline 61 | 62 | # linear terms to tree terms 63 | # a$. b c$. d e --> a (b c) (d e) 64 | # a$. b c$. d e --> a (; (b c) (d e)) 65 | # : inner-block:*exp, remaining-exps:Terms 66 | exps_trees_at space:N line_exps:Exps block_trees:Exps : Exps ? Exps, Exps = 67 | (spot, Level space0), exps? 68 | | (_, Level _? 1) exps.List.opt0 & # skip consecutive newlines 69 | exps_trees_at space line_exps block_trees exps 70 | 71 | | space0 < space & # pop, keep exps.head to keep popping 72 | (rev_exps_trees 0 line_exps block_trees).List.rev, ((spot, Level space0), exps) 73 | 74 | | space0 > space & # sub-block 75 | block, exps2 = exps_trees_at space0 0 0 exps 76 | | space0 == space + 1 & # arguments 77 | exps_trees_at space block.List.rev+line_exps block_trees exps2 78 | | # space0 == space + 2 # steps 79 | exps_trees_at space (rev_exps_steps block.List.rev line_exps) block_trees exps2 80 | 81 | | # space0 == space & 82 | exps_trees_at space0 0 (rev_exps_trees 0 line_exps block_trees) exps # same line 83 | 84 | exp, exps? exps_trees_at space (exp, line_exps) block_trees exps 85 | 86 | ? (rev_exps_trees 0 line_exps block_trees).List.rev, [] # line_exps == 0 if there's a trailing newline 87 | 88 | exps_trees x:Exps : Exps = exps_trees_at 0 0 0 x . 0 89 | 90 | # limit: a '(' b c' )' d --> a (b c) d 91 | # : inner-groups:*exp, end-exp:Exp remaining-exp:*exp 92 | limit_exps_to groups:Exps end_char:!S : Exps ? Exps, !Spot, Exps = 93 | (spot, Op '('), exps? 94 | groups2, end_spot, exps2 = limit_exps_to 0 ')' exps # sub-group 95 | end_spot | Exp.seq_error $Fun 'missing )' groups2 96 | # must use end-exp with exp2_spot to calculate the largest span of positions for [glue_exp] below, e.g. x+(y + z) 97 | spot2 = Spot.spot2 spot end_spot 98 | limit_exps_to (rev_exps_trees spot2 groups2 groups) end_char exps2 99 | 100 | (spot, Op '['), exps? 101 | groups2, end_spot, exps2 = limit_exps_to 0 ']' exps 102 | end_spot | Exp.seq_error $Fun 'missing ]' groups2 103 | # [a,b] vs [a, b] vs [f x], hence invalid to append ,0 since a,b,0 but f x,0 vs (f x), 0 - fix glue_exps 104 | # [a, (b, c)] vs [a, b, c], hence invalid to rewrite as (list (a, (b, c))) which is the same as (list (a, b, c)) - fix associate_exps 105 | # [a, b] vs [(a, b)], hence list vs list1 - fix List.size groups2 106 | list = 107 | | groups2 & 108 | glued = groups2.List.rev.glue_exps 109 | spot1 = groups2.List.head.Exp.spot.Spot.end # list's last element 110 | spot2 = Spot.spot2 spot1 end_spot # list's end marker 111 | spot0 = Spot.spot2 spot end_spot # the whole list 112 | spot3 = !groups2 > 1 & !glued > 1 & spot2 | spot1 # [f a] or [(a, b)] 113 | #exps_spot_exp spot0 ((spot2, Nat 0), (spot3, Op ','), groups2).List.rev 114 | spot0, Tree [(spot2, Name 'List'), (spot2, Tree ((spot2, Nat 0), ((spot3, Op ','), groups2)).List.rev)] 115 | # spot0, Tree [(spot2, Name 'List'), (spot2, Tree groups2.List.rev)] 116 | | end_spot, Nat 0 117 | limit_exps_to list,groups end_char exps2 # [a,b] => list (a,b) 118 | 119 | (spot, Op o), exps & end_char & o == end_char? groups, spot, exps 120 | 121 | (_, Tree s), exps? 122 | limit_exps_to (exps_exp (limit_exps_to 0 end_char s).0, groups) end_char exps 123 | 124 | exp, exps? limit_exps_to exp,groups end_char exps 125 | 126 | ? List.rev groups, 0, 0 127 | 128 | limit_exps exps:Exps : Exps = limit_exps_to 0 0 exps . 0 129 | 130 | exps_exp exps:Exps : Exp = exps.List.tail & Exp.spot_new exps.List.head, Tree exps | exps.List.head 131 | exps_spot_exp spot:Spot exps:Exps : Exp = exps.List.tail & spot, Tree exps | exps.List.head 132 | 133 | # left-leaning: a, b --> (, a b) not (, a) b 134 | # right-associative: a, b, c --> a, (b, c) not (a, b), c 135 | op_lean name:S : B = List.in S.eq [';', ',', '?'] name 136 | 137 | # glue tight adjucent-column exps: a b+c d --> a (b + c) d 138 | # [glue] comes after [limit], else f (x + y) becomes f [(x] + [y)] 139 | glue_exps_to groups:Exps : Exps? Exps = 140 | exp, exps? 141 | _, _, _, line0, column0 = exp.Exp.spot 142 | _, line11, column11, line12, column12 = exps.List.opt0.Exp.spot_new 143 | _, line2, column2, _ = exps.List.opt1.Exp.spot_new 144 | exp . 145 | _ & line11 == line0 & column11 == column0 & (!((_, Op o? op_lean o) exps.0) | line2 == line12 & column2 == column12)? 146 | glue_exps_to (glue_exp exp, groups) exps 147 | _, Tree s? 148 | exps_exp (List.rev (exps_exp (glue_exps s), groups)), glue_exps exps 149 | ? exps_exp (List.rev (exp, groups)), glue_exps exps 150 | ? groups 151 | 152 | glue_exps exps:Exps : Exps = glue_exps_to 0 exps 153 | 154 | glue_exp : Exp? Exp = 155 | _, Tree s? exps_exp (glue_exps s) 156 | a? a 157 | 158 | # split a + b ^ c = [a], +, [b ^ c] where + has a lower rank/precedence than ^ 159 | #split_exps left:Exp op:Exp rank:N right:Exp exps:Exps : left:Exps, op:Exp, right:Exps = 160 | split_exps left:Exps op:!Exp rank:N right:Exps exps0:Exps : Exps = exps0,op . 161 | exp,exps, _? 162 | rank2 = (_, Op o? Op.rank o) exp 163 | same = (_, Op o? Op.right o) exp 164 | | rank2 & (same & rank2 < rank | rank2 <= rank) & 165 | # given f x + g y = h z 166 | # at reading op=, x f, +, y g 167 | # change left to y g + x f for f x + g y reversed 168 | right2 = op & (op, right.List.rev) | right.List.rev 169 | split_exps (left.List.rev + right2).List.rev exp rank2 0 exps 170 | | 171 | split_exps left op rank exp,right exps 172 | 173 | _, (spot, Op op2)? 174 | left2 = left & exps_exp (associate_exps left.List.rev) 175 | right0 = right & associate_exps right.List.rev 176 | #right2 = right & exps_exp (associate_exps right.List.rev) 177 | right2 = right,right0 . 178 | [(_, Tree _)], [(_, Binary _ ',' _)] & op2 == ','? spot, Tree right0 179 | ? right & exps_exp right0 180 | | left & right & op2 == '|' & left2.Exp.tree . 181 | Binary a '&' b & !left > 1? [(spot, Tree [(spot, Name 'op_if'), a, b, right2])] # a & b | c -> op_if a b c 182 | ? [(spot, Tree [(spot, Name 'op_if0'), left2, right2])] # a | b -> op_if0 a b 183 | | left & right & [(spot, Binary left2 op2 right2)] # (a & b) | c -> (a & b) | c 184 | | left & [(spot, Post left2 op2)] 185 | | right & [(spot, Pre op2 right2)] 186 | 187 | # associate by operator precedence: a + b ^ c --> a + (b ^ c) 188 | associate_exps exps:Exps : Exps = exps & (split_exps 0 0 0ffff 0 exps | exps associate_exp) # 0ffff = max precedence 189 | 190 | 191 | associate_exp : Exp? Exp = 192 | _, Tree s? exps_exp (associate_exps s) 193 | a? a 194 | 195 | exps s:Exps : Exps = s.exps_trees.limit_exps.glue_exps.associate_exps 196 | 197 | of x:S : S = x.Exp.str_exps.exps.0.Exp.str 198 | #of x:S : S = x.Exp.str_exps.exps.0.Exp.str.Log.id 199 | Fact (of 'a' == 'a') 200 | 201 | Fact (of 'a+b' == '(a + b)') 202 | Fact (of 'f a+b' == '(f (a + b))') 203 | 204 | Fact (of 'a,b' == '(a, b)') 205 | Fact (of 'a,b,c' == '(a, (b, c))') 206 | Fact (of 'a,(b,c)' == '(a, ((b, c)))') 207 | Fact (of 'x = a, b' == '(x = (a, b))') 208 | 209 | Fact (of 'a+[b]' == '(a + (List (b, 0)))') 210 | Fact (of '[a,b]' == '(List (a, (b, 0)))') 211 | Fact (of '[a,b,c]' == '(List (a, (b, (c, 0))))') 212 | Fact (of '[a,(b,c)]' == '(List (a, ((b, c), 0)))') 213 | -------------------------------------------------------------------------------- /fun.m: -------------------------------------------------------------------------------- 1 | # function, procedure, routine 2 | 3 | https://en.wikipedia.org/wiki/Function_type 4 | https://en.wikipedia.org/wiki/Abstraction_(computer_science) 5 | https://en.wikipedia.org/wiki/Parameter_(computer_programming)#Parameters_and_arguments 6 | 7 | # http://x86-64.org/documentation/abi.pdf 8 | p20 For calls that may call functions that use varargs or stdargs (prototype-less calls or calls to functions 9 | containing ellipsis (. . . ) in the declaration) %al16 is used as hidden argument to specify the number of vector 10 | registers used. Note that the rest of %rax is undefined, only the contents of %al is defined. The content of %al do 11 | not need to match exactly the number of registers, but must be an upper bound on the number of vector registers used 12 | and is in the range 0-8 inclusive. [al] does not seem to have effect on, for example, printf. 13 | 14 | call0 fun:Z?0 : 0 = Asm 15 | mov b sp 8 16 | mov bp sp 17 | and sp 0ffff_fff0 # align stack to 16-byte, see Align 18 | call b 19 | mov sp bp 20 | mov sp 16 a 21 | ret 22 | 23 | call1 fun:0?1 x:0 : 1 = Asm 24 | mov b sp 16 25 | mov di sp 8 26 | mov bp sp 27 | and sp 0ffff_fff0 28 | call b 29 | mov sp bp 30 | mov sp 24 a 31 | ret 32 | 33 | call_nr fun:0?R x:0 : R = Asm 34 | mov b sp 16 35 | mov di sp 8 36 | mov bp sp 37 | and sp 0ffff_fff0 38 | call b 39 | mov sp bp 40 | mov a xmm0 41 | mov sp 24 a 42 | ret 43 | 44 | call_rr fun:R?R x:R : R = Asm 45 | mov b sp 16 46 | mov a sp 8 47 | mov xmm0 a 48 | mov bp sp 49 | and sp 0ffff_fff0 50 | call b 51 | mov sp bp 52 | mov a xmm0 53 | mov sp 24 a 54 | ret 55 | 56 | call_rrr fun:R?R?R x:R y:R : R = Asm 57 | mov b sp 24 58 | mov a sp 16 59 | mov xmm0 a 60 | mov a sp 8 61 | mov xmm1 a 62 | mov bp sp 63 | and sp 0ffff_fff0 64 | call b 65 | mov sp bp 66 | mov a xmm0 67 | mov sp 32 a 68 | ret 69 | 70 | call2 fun:0?1?2 x:0 y:1 : 2 = Asm 71 | mov b sp 24 72 | mov di sp 16 73 | mov si sp 8 74 | mov bp sp 75 | and sp 0ffff_fff0 76 | call b 77 | mov sp bp 78 | mov sp 32 a 79 | ret 80 | 81 | call3 fun:0?1?2?3 x:0 y:1 z:2 : 3 = Asm 82 | mov b sp 32 83 | mov di sp 24 84 | mov si sp 16 85 | mov d sp 8 86 | mov bp sp 87 | and sp 0ffff_fff0 88 | call b 89 | mov sp bp 90 | mov sp 40 a 91 | ret 92 | 93 | # so far, only used by Dbm.fetch. run [./min2 dbm] 94 | call3_r2 fun:0?1?2?3,4 x:0 y:1 z:2 : 3,4 = Asm 95 | mov b sp 32 96 | mov di sp 24 97 | mov si sp 16 98 | mov d sp 8 99 | mov bp sp 100 | and sp 0ffff_fff0 101 | call b 102 | mov sp bp 103 | 104 | mov r11 16 105 | call Mem.main_reg 106 | mov r11 0 a 107 | mov r11 8 d 108 | mov sp 40 r11 109 | ret 110 | 111 | call4 fun:0?1?2?3?4 x:0 y:1 z:2 w:3 : 4 = Asm 112 | mov b sp 40 113 | mov di sp 32 114 | mov si sp 24 115 | mov d sp 16 116 | mov c sp 8 117 | mov bp sp 118 | and sp 0ffff_fff0 119 | call b 120 | mov sp bp 121 | mov sp 48 a 122 | ret 123 | 124 | call5 fun:0?1?2?3?4?5 x:0 y:1 z:2 w:3 v:4 : 5 = Asm 125 | mov b sp 48 126 | mov di sp 40 127 | mov si sp 32 128 | mov d sp 24 129 | mov c sp 16 130 | mov r8 sp 8 131 | mov bp sp 132 | and sp 0ffff_fff0 133 | call b 134 | mov sp bp 135 | mov sp 56 a 136 | ret 137 | 138 | call6 fun:0?1?2?3?4?5?6 x:0 y:1 z:2 w:3 u:4 v:5 : 6 = Asm 139 | mov b sp 56 140 | mov di sp 48 141 | mov si sp 40 142 | mov d sp 32 143 | mov c sp 24 144 | mov r8 sp 16 145 | mov r9 sp 8 146 | mov bp sp 147 | and sp 0ffff_fff0 148 | call b 149 | mov sp bp 150 | mov sp 64 a 151 | ret 152 | 153 | #call5x fun:0?1?2?3?4?5 x:0 y:1 z:2 w:3 v:4 u:5 : 6 = Asm 154 | # first arg = struct CGRect 0 0 a a, which is passed in stack 155 | call5x a:5 fun:0?1?2?3?4?5 x:0 y:1 z:2 w:3 v:4 : 5 = Asm # a as struct, special param passing 156 | mov a sp 56 157 | mov b sp 48 158 | mov di sp 40 159 | mov si sp 32 160 | mov d sp 24 161 | mov c sp 16 162 | mov r8 sp 8 163 | 164 | mov bp sp 165 | and sp 0ffff_fff0 166 | 167 | push a # first arg = struct CGRect 0 0 a a 168 | push a 169 | push 0 170 | push 0 171 | 172 | call b 173 | mov sp bp 174 | mov sp 56 a 175 | ret 176 | 177 | call6x fun:0?1?2?3?4?5?6 x:0 y:1 z:2 w:3 v:4 u:5 : 6 = Asm # fixme - last argument not passed in stack, see main.ma 178 | # same as call6 179 | mov b sp 56 180 | mov di sp 48 181 | mov si sp 40 182 | mov d sp 32 183 | mov c sp 24 184 | mov r8 sp 16 185 | mov r9 sp 8 186 | mov bp sp 187 | and sp 0ffff_fff0 188 | call b 189 | mov sp bp 190 | mov sp 64 a 191 | ret 192 | 193 | # https://en.wikipedia.org/wiki/%CE%9C-recursive_function 194 | mem x:0?1 : Mem = Cast.mem x 195 | 196 | id x:0 : 0 = x 197 | 198 | # https://en.wikipedia.org/wiki/Currying#Partial_application 199 | # https://en.wikipedia.org/wiki/Closure_(computer_programming) 200 | # support only 32-bit address/data, due to [push n] 201 | # use function variable, not direct call; otherwise, wrong relative rip for call 202 | # 0000005A 68E2120000 push qword 0x12e2 203 | # 0000005F 6800000000 push qword 0x0 204 | # 00000064 682A000000 push qword 0x2a 205 | # 00000069 48FFB42420000000 push qword [rsp+0x20] 206 | # 00000071 48FF942418000000 call qword [rsp+0x18] 207 | # 00000079 4881C410000000 add rsp,0x10 208 | # 00000080 4858 pop rax 209 | # 00000082 4881C408000000 add rsp,0x8 210 | # 00000089 4889842410000000 mov [rsp+0x10],rax 211 | # 00000091 C3 ret 212 | # 00000092 213 | mold1 x:0 : 1 = (f = Any.cast_fun3 0; f 0 x) 214 | mold1_end _:N : N = 0 215 | 216 | # Used in Unify.apply 217 | # Need maxprot/initprot = 7 = xwr for __DATA in main.ma 218 | # (f x) y 219 | new1_1 f:0?1?2 x:0 : 1?2 = 220 | g = Mem.span mold1.mem mold1_end.mem # 092-05a = 56 221 | Mem.set2 g+!base+1 f.Cast.nat # skip 0x68 222 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 - skip 0x68, 00000064 push qword 0x2a, 0000005A push qword 0x12e2 223 | Cast.any g 224 | Fact (f = new1_1 N.add 40; f 2 == 42) 225 | #Fact ((new1_1 N.add 40) 2 == 42) # unsupported 226 | Fact (f = N.add 40; f 2 == 42) 227 | Fact ((N.add 40) 2 == 42) 228 | 229 | # (f x) y z = f x y z 230 | mold1_2 y:0 z:1 : 2 = (f = Any.cast_fun4 0; f 0 y z) 231 | mold1_2_end _:N : N = 0 232 | 233 | # same as 1 (1 f) 234 | new1_2 f:0?1?2?3 x:0 : 1?2?3 = 235 | g = Mem.span mold1_2.mem mold1_2_end.mem 236 | Mem.set2 g+!base+1 f.Cast.nat # skip 0x68 237 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 - skip 0x68, 00000064 push qword 0x2a, 0000005A push qword 0x12e2 238 | Cast.any g 239 | 240 | # (f x) y z w = f x y z w 241 | mold1_3 y:0 z:1 w:2 : 3 = (f = Any.cast_fun5 0; f 0 y z w) 242 | mold1_3_end _:N : N = 0 243 | 244 | new1_3 f:0?1?2?3?4 x:0 : 1?2?3?4 = 245 | g = Mem.span mold1_3.mem mold1_3_end.mem # 092-05a = 56 246 | Mem.set2 g+!base+1 f.Cast.nat # skip 0x68 247 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 - skip 0x68, 00000064 push qword 0x2a, 0000005A push qword 0x12e2 248 | Cast.any g 249 | 250 | # (f x y) z 251 | mold2 x:0 : 1 = (f = Any.cast_fun4 0; f 0 0 x) 252 | mold2_end _:N : N = 0 253 | new2_1 f:0?1?2?3 x:0 y:1 : 2?3 = 254 | g = Mem.span mold2.mem mold2_end.mem 255 | Mem.set2 g+!base+1 f.Cast.nat # 0 + 1 256 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 257 | Mem.set2 g+!base+16 y # 0x69 - 0x5a + 1 258 | Cast.any g 259 | Fact (Pair.str_by N.str N.str 13,42 == '13,42') 260 | Fact (Pair.str_by (Pair.str_by N.str N.str) N.str (3,13),42 == '3,13,42') # (3,13),42 261 | Fact ((Pair.str_by N.str N.str) 13,42 == '13,42') 262 | #Fact ((Fun.new2_1 Pair.str_by N.str N.str) 13,42 == '13,42') # unsupported 263 | Fact (f = Fun.new2_1 Pair.str_by N.str N.str; f 13,42 == '13,42') 264 | Fact (f = Fun.new2_1 Pair.str_by N.str N.str; g = Fun.new2_1 Pair.str_by f N.str; g (3,13),42 == '3,13,42') 265 | #Fact (f = Fun.new2_1 Pair.str_by N.str N.str; Fun.new2_1 Pair.str_by f N.str (3,13),42 == '3,13,42') # unsupported 266 | 267 | # Fun.new* skips Step.exp_steps for function pre steps - STEP_FUN_PRE 268 | base = %0 : %N 269 | Fact (f = new2_1 (_ x:N y:N z:N : N = x + y + z) 2 3; f 5 == 10) 270 | 271 | mold2_2 z:0 w:1 : 2 = (f = Any.cast_fun5 0; f 0 0 z w) 272 | mold2_2_end _:N : N = 0 273 | 274 | new2_2 f:0?1?2?3?4 x:0 y:1 : 2?3?4 = 275 | g = Mem.span mold2_2.mem mold2_2_end.mem 276 | Mem.set2 g+!base+1 f.Cast.nat # skip 0x68 277 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 - skip 0x68, 00000064 push qword 0x2a, 0000005A push qword 0x12e2 278 | Mem.set2 g+!base+16 y 279 | Cast.any g 280 | Fact (f = new2_2 (_ x:N y:N z:N w:N : N = x + y + z + w) 2 3; f 5 8 == 18) 281 | 282 | mold2_3 z:0 p:1 q:2 : 3 = (f = Any.cast_fun6 0; f 0 0 z p q) 283 | mold2_3_end _:N : N = 0 284 | 285 | new2_3 f:0?1?2?3?4?5 x:0 y:1 : 2?3?4?5 = 286 | g = Mem.span mold2_3.mem mold2_3_end.mem 287 | Mem.set2 g+!base+1 f.Cast.nat # skip 0x68 288 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 - skip 0x68, 00000064 push qword 0x2a, 0000005A push qword 0x12e2 289 | Mem.set2 g+!base+16 y 290 | Cast.any g 291 | Fact (f = new2_3 (_ x:N y:N z:N p:N q:N : N = x + y + z + p + q) 2 3; f 5 8 13 == 31) 292 | 293 | # (f x y z) w 294 | mold3 x:0 : 1 = (f = Any.cast_fun5 0; f 0 0 0 x) 295 | mold3_end _:N : N = 0 296 | new3_1 f:0?1?2?3?4 x:0 y:1 z:2 : 3?4 = 297 | g = Mem.span mold3.mem mold3_end.mem 298 | Mem.set2 g+!base+1 f.Cast.nat # 0 + 1 299 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 300 | Mem.set2 g+!base+16 y # 0x69 - 0x5a + 1 301 | Mem.set2 g+!base+21 z # 16+5 302 | Cast.any g 303 | Fact (f = new3_1 (_ x:N y:N z:N w:N : N = x + y + z + w) 2 3 5; f 8 == 18) 304 | 305 | # (f x y z) w u 306 | mold3_2 z:0 w:1 : 2 = (f = Any.cast_fun6 0; f 0 0 0 z w) 307 | mold3_2_end _:N : N = 0 308 | new3_2 f:0?1?2?3?4?5 x:0 y:1 z:2 : 3?4?5 = 309 | g = Mem.span mold3_2.mem mold3_2_end.mem 310 | Mem.set2 g+!base+1 f.Cast.nat # 0 + 1 311 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 312 | Mem.set2 g+!base+16 y # 0x69 - 0x5a + 1 313 | Mem.set2 g+!base+21 z # 16+5 314 | Cast.any g 315 | Fact (f = new3_2 (_ x:N y:N z:N w:N u:N : N = x + y + z + w + u) 2 3 5; f 8 13 == 31) 316 | 317 | # (f x y z w) u 318 | mold4 x:0 : 1 = (f = Any.cast_fun6 0; f 0 0 0 0 x) 319 | mold4_end _:N : N = 0 320 | new4_1 f:0?1?2?3?4?5 x:0 y:1 z:2 w:3 : 4?5 = 321 | g = Mem.span mold4.mem mold4_end.mem 322 | Mem.set2 g+!base+1 f.Cast.nat # 0 + 1 323 | Mem.set2 g+!base+11 x # 0x64 - 0x5a + 1 324 | Mem.set2 g+!base+16 y # 0x69 - 0x5a + 1 325 | Mem.set2 g+!base+21 z # 16+5 326 | Mem.set2 g+!base+26 w # 21+5 327 | Cast.any g 328 | Fact (f = new4_1 (_ x:N y:N z:N w:N u:N : N = x + y + z + w + u) 2 3 5 8; f 13 == 31) 329 | 330 | loop f:Z?Z = (f 0; loop f) 331 | 332 | arity : Type ? N = 333 | _, Binary _ '?' type? 1 + arity type 334 | ? 0 335 | 336 | # https://en.wikipedia.org/wiki/Function_composition compose then 337 | of g:1?2 f:0?1 x:0 : 2 = g (f x) 338 | Fact (of S.size List.head ['fooo', 'bar'] == 4) 339 | # Fact ((List.head . of S.size) ['fooo', 'bar'] == 4) # todo - two-step apply 340 | Fact (f = List.head . of S.size; f ['fooo', 'bar'] == 4) 341 | Fact (f = of S.size List.head; f ['fooo', 'bar'] == 4) 342 | 343 | do f:Z?0 : 0 = f 0 344 | 345 | callx f:Z?0 : 0 = f 0 346 | -------------------------------------------------------------------------------- /exp.m: -------------------------------------------------------------------------------- 1 | # expression, tree, phrase, parser form 2 | 3 | https://en.wikipedia.org/wiki/Expression_(mathematics) 4 | https://en.wikipedia.org/wiki/Expression_(computer_science) 5 | 6 | Terms = *Term 7 | Exp = Spot, Term 8 | Exps = *Exp 9 | 10 | spot x:Exp : Spot = x.0 11 | spot_new x:Exp : Spot = x & x.0 | Spot 0 12 | tree x:Exp : Term = x.1 13 | tag exp:Exp : N = exp.tree.Term.tag 14 | item exp:Exp : 0 = exp.tree.Term.item 15 | 16 | str x:Exp : S = Term.str x.tree 17 | opt_str x:!Exp : S = x & Term.str x.tree | '!!' 18 | strs x:Exp : S = x.str + 0a.C.str 19 | put x:Exp = x.str.Put 20 | opt_put x:Exp = x.opt_str.Put 21 | log x:Exp = x.str.Log 22 | err x:Exp = x.str.Err 23 | 24 | opt_log x:Exp = x.opt_str.Log 25 | 26 | seq_str x:Exps : S = List.map_str x str 27 | seq_strs x:Exps : S = List.map_str x strs 28 | seq_str_pair x:Exps : S = List.map_str_pair x str 29 | seq_str_seq x:Exps : S = List.map_str_seq x str 30 | seq_put x:Exps = x.seq_str.Put 31 | seq_puts x:Exps = List.do x put 32 | seq_spot_puts x:Exps = List.do x spot_put 33 | seq_tee x:Exps : Exps = (List.map_log x str; x) 34 | seq_out x:Exps = List.map_out x str 35 | seq_log x:Exps = x.seq_str.Log 36 | 37 | seq_logs x:Exps = List.do x log 38 | 39 | spot_str spot,term:Exp : S = spot.Spot.str + ':' + term.str 40 | 41 | spot_put x:Exp = x.spot_str.Put 42 | 43 | spot_log x:Exp = x.spot_str.Log 44 | 45 | spot_basic_str x:Exp : S = 46 | spot, term = x 47 | spot.Spot.basic_str + ':' + term.Term.str 48 | 49 | spot_basic_put x:Exp = x.spot_basic_str.Put 50 | spot_basic_log x:Exp = x.spot_basic_str.Log 51 | 52 | seq_spot_str x:Exps : S = List.map_str x spot_str 53 | seq_spot_put x:Exps = List.do x spot_put 54 | seq_spot_log x:Exps = x.seq_spot_str.Log 55 | seq_spot_logs x:Exps = List.do x spot_log 56 | seq_spot_basic_put x:Exps = List.do x spot_basic_put 57 | 58 | # : Spot 59 | spot2 x:Exp y:Exp : Spot = 60 | path, line1, column1, _ = spot x 61 | _, _, _, line2, column2 = spot y 62 | path, line1, column1, line2, column1 63 | 64 | # e -> e for e = n, s, x 65 | # e -> x = e; x 66 | bind_name exp:Exp : !Exp, Exp = 67 | | is_pure exp & 0, exp 68 | | 69 | spot = spot exp 70 | name = spot, Name 'x'.S.tick 71 | (spot, Binary name '=' exp), name 72 | 73 | # is atomic, cheap, effect-free 74 | is_pure : Exp ? B = 75 | _, Char _? 1 76 | _, Str _? 1 77 | _, Nat _? 1 78 | _, Name _? 1 79 | # mem alloc, but io-free? Constructor name.S.char.C.is_upper 80 | 81 | _binary_exp op:S x:Exp y:Exp : Exp = x.spot, Binary x op y 82 | 83 | binary_exps op:S s:Exps : !Exp = List.sum2 s (_binary_exp op) 84 | 85 | binary_exps1 op:S s:Exp,Exps : Exp = List.sum2 s (_binary_exp op) 86 | 87 | # long, multiline comment 88 | comment_next path:S line:N level:N s:S : N, N, !Term, N, N, !S = 89 | r = S.cut_not s+1 \ 90 | | r - s+1 > level & comment path line+1 level r 91 | | S.char r == 0a & comment_next path line+1 level r 92 | | str_tree path line 0 s 93 | 94 | comment path:S line:N level:N s:S : N, N, !Term, N, N, !S = 95 | x = S.char s 96 | comment_next path line level (S.cut s 0a) 97 | 98 | # long, multiline string 99 | cut_str line:N column:N s:S : S, N = 100 | r = S.cut_not s \ 101 | | (r - s > column | S.char r == 0a) & cut_str line+1 column (S.cut s 0a + 1) 102 | | s, line 103 | 104 | term_str_eq s:S x:Term n:N : B = 105 | y, r = str_num s s 106 | Term.eq x y & r == s+n 107 | 108 | # compare to Rewrite.REWRITE_REAL 109 | [0-9][0-9_]*\.[0-9][0-9_]*\.[0-9][0-9_]* 110 | 111 | num 3.(f x) 3.f 3.f^4 when followed immediately by an atomic term such as name or (exp) or [exp] 112 | real 3.+4. 3. + x 3.14 when followed by number or space or EOF or operators other than . 113 | str_num s0:S s:S : Term, S = s.S.char . 114 | \.? 115 | r = S.cut_by s+1 C.is_dec 116 | | (r == s + 1 & (x = S.char r; C.is_letter x | x == \( | x == \[)) & Nat (S.nat (S.span s0 s)), s 117 | | S.char r == \. & C.is_dec (r+1).S.char & 118 | t = S.cut_by r+1 C.is_dec 119 | base = S.span s0 r 120 | exp = S.span r+1 t 121 | Real (R.of_exp base exp), t 122 | | Real (R.of (S.span s0 r)), r 123 | x & C.is_dec x? str_num s0 s+1 124 | ? Nat (S.nat (S.span s0 s)), s 125 | Fact (term_str_eq '42foo' (Nat 42) 2) 126 | Fact (term_str_eq '42foo' (Nat 42) 2) 127 | Fact (term_str_eq '42.foo' (Nat 42) 2) 128 | Fact (term_str_eq '42. foo' (Real 42.) 3) 129 | Fact (term_str_eq '42.3foo' (Real 42.3) 4) 130 | Fact (term_str_eq '42.' (Real 42.) 3) 131 | Fact (term_str_eq '3.f' (Nat 3) 1) 132 | Fact (term_str_eq '3.(f x)' (Nat 3) 1) 133 | Fact (term_str_eq '3.f^4' (Nat 3) 1) 134 | Fact (term_str_eq '3.+4.' (Real 3.) 2) 135 | Fact (term_str_eq '3. + x' (Real 3.) 2) 136 | Fact (term_str_eq '3.14' (Real 3.14) 4) 137 | Fact (term_str_eq '2.99.8 light' (Real 2.99.8) 6) 138 | 139 | 140 | # glue_tree needs both the starting position (line1, column1) and the ending position (line2, column2) 141 | #str_tree path:S line:N column:N s:S : line1:N, column1:N, tree:Term, line2;N, column2:N, S = 142 | str_tree path:S line:N column:N s:S : N, N, !Term, N, N, !S = 143 | x = S.char s 144 | y = x & S.char s+1 145 | | x == 0 & 0, 0, 0, 0, 0, 0 146 | | x == \ & str_tree path line column+1 s+1 147 | | x == \# & comment path line column s+1 148 | 149 | # | x == \\ & line, column, Char y, line, column + 2, s + 2 150 | | x == \\ & 151 | c, r = Unicode.char s+1 152 | line, column, Char c, line, column + 2, r 153 | 154 | | x == 0a & 155 | r = S.cut_not s+1 \ 156 | line, column, Level r-s-1, line + 1, r - s+1, r 157 | 158 | | x == \' & 159 | r, line2, column2 = S.cut_quote s+1 line column 160 | | r & line, column, Str (S.quote (S.span s+1 r)), line2, column2, r + 1 161 | | Fail.fill '$s:$n:$n: $s missing closing quote' [path, line, column, $Fun] 162 | 163 | | x == \" & y == \" & 164 | r, n = cut_str 0 column s+2 165 | line, column, Str (S.meta (S.span s+2 r)), line + n, column, r 166 | 167 | | x == \" & 168 | r, n = S.cut_line s+1 \" 0 # fixme - cut_line returns columns as well 169 | line, column, Str (S.meta (S.span s+1 r)), line + n, column + r-s, r + 1 170 | 171 | | x == \0 & y != \. & 172 | | y == \' & 173 | r, n = S.cut_line s+2 \' 0 174 | line, column, Mem_ (Mem.of_hex (S.span s+2 r)), line + n, column + r-s, r + 1 175 | | 176 | r = S.cut_by s+1 C.is_hex 177 | line, column, Nat (S.hex (S.span s+1 r)), line, column + r-s, r 178 | 179 | | x == \_ & C.is_bin y & 180 | r = S.cut_by s+1 C.is_lo_bin 181 | line, column, Nat (S.bin (S.span s+1 r)), line, column + r-s, r 182 | 183 | # | x == \_ & C.is_hex y & 184 | # r = S.cut_by s+1 C.is_hex 185 | # line, column, Mem_ (Mem.of_hex (S.span s+1 r)), line, column + r-s, r 186 | 187 | | ((x == \= & y == \=) | (x == \! & y == \=) | (x == \< & y == \=) | (x == \> & y == \=)) & # == != <= >= 188 | line, column, Op (C.str2 x y), line, column + 2, s + 2 189 | 190 | # | C.is_digit x & 191 | # r = S.cut_by s+1 C.is_dec 192 | # line, column, Nat (S.nat (S.span s r)), line, column + r-s, r 193 | 194 | | C.is_digit x & 195 | num, r = str_num s s 196 | line, column, num, line, column + r-s, r 197 | 198 | | S.has '~,!@$%^&*()-=+[{]}|;:,<.>/?' x & # except \#'"0-9A-Za-z 199 | line, column, Op (C.str x), line, column + 1, s + 1 200 | 201 | | C.is_alpha x & 202 | r = S.cut_by s+1 C.is_alpha 203 | line, column, Name (S.span s r), line, column + r-s, r 204 | 205 | | 206 | u, r = Unicode.char s 207 | | Unicode.is_name u & line, column, Name (S.span s r), line, column + 1, r 208 | | Unicode.is_op u & line, column, Op (S.span s r), line, column + 1, r 209 | | Fail.fill '$s:$n:$n: $s invalid character $c near$.$s' [path, line, column, $Fun, x, S.heads s 100] 210 | 211 | str_term x:S : !Term = str_tree $Fun Spot.line_base Spot.col_base x . 2 212 | Fact (Term.eq (str_term '3.1415') (Real 3.1415)) 213 | Fact (Term.eq (str_term '3.0015') (Real 3.0015)) 214 | Fact (Term.eq (str_term '0.1415') (Real 0.1415)) 215 | Fact (Term.eq (str_term '0.0015') (Real 0.0015)) 216 | Fact (Term.eq (str_term '_10_1010') (Nat 42)) 217 | 218 | str_exps_at path:S line:N column:N str:S : Exps = 219 | line1, column1, tree, line2, column2, str2 = str_tree path line column str 220 | tree & ((path, line1, column1, line2, column2), tree), str_exps_at path line2 column2 str2 221 | 222 | str_exps_nil x:S : Exps = str_exps_at $Fun Spot.line_base Spot.col_base x # useless, dummy debug value 223 | 224 | str_exps x:S : Exps = str_exps_at $Fun Spot.line_base Spot.col_base x 225 | 226 | str_exps2 path,line,col,_,_:Spot x:S : Exps = str_exps_at path line col x 227 | 228 | of_nil x:S : Exp = x.str_exps.Group.exps.Rewrite.exps.List.at0 # useless, dummy debug value 229 | 230 | of x:S : Exp = x.str_exps.Group.exps.Rewrite.exps.List.at0 231 | 232 | of2 spot,x:Spot,S : Exp = x.(str_exps2 spot).Group.exps.Rewrite.exps.List.at0 233 | 234 | tnat : Type? Type = 235 | spot, Str n? spot, Tnat n.S.nat # "0" -> #0 236 | spot, Tree s? spot, Tree tnat.s 237 | spot, Row s? spot, Row_ tnat.s 238 | spot, Pre o t? spot, Pre o t.tnat 239 | spot, Post t o? spot, Post t.tnat o 240 | spot, Binary t o u? spot, Binary t.tnat o u.tnat 241 | t? t 242 | 243 | type_of x:S : Type = x.of.tnat 244 | Fact (eq1 (type_of '"42"') (Tnat 42)) 245 | Fact (type_of 'N, "0"' . str == '(N,#0)') 246 | 247 | path_exps path:S : Exps = str_exps_at path Spot.line_base 0 path.Path # fixme - Spot.col_base 248 | 249 | unit_exps units:*S : Exps = # todo - check units unique 250 | paths = units (_ x:S : S = S.add x '.m') 251 | (List.map_add paths path_exps).Group.exps.Rewrite.exps 252 | 253 | paths_exps paths:*S : Exps = (List.map_add paths path_exps).Group.exps.Rewrite.exps 254 | 255 | file_exps file:File : Exps = 256 | file.File.in.str_exps.Group.exps 257 | 258 | # [file_exps] joins two exps as fun app. [file_exps2] gives a pair of exp. 259 | file_exps2 file:File : Exp, Exp = 260 | s = file.File.in.str_exps.Group.exps 261 | s.0.Rewrite.exp, s.1.Rewrite.exp 262 | 263 | seq_error fun:S x:S exps:Exps : 0 = Fail.main4 exps.0.spot.Spot.str fun x exps.seq_str 264 | 265 | seq_error_log fun:S x:S exps:Exps = Log.main4 exps.0.spot.Spot.str+':' fun x exps.seq_str 266 | 267 | is_fun : Exp ? B = 268 | _, Binary _ '?' _? 1 269 | _, Binary (_, Binary _ '?' _) ';' _? 1 270 | 271 | at_spot spot:Spot terms:Terms : Exps = terms (Pair.main spot) 272 | 273 | eq _,x:Exp _,y:Exp : B = Term.eq x y 274 | Fact (eq (Kind.of '1,2') (Kind.of '1,2')) 275 | 276 | eq1 _,x:Exp y:Term : B = Term.eq x y 277 | Fact (eq1 (Kind.of '"42"') (Tnat 42)) 278 | 279 | seq_row1 s:*Exp : Exp = List.sum2 s (_ a:Exp b:Exp : Exp = a.Exp.spot, Row_ [a, b]) 280 | 281 | seq_row s:*Exp : Exp = List.sum (_ a:Exp b:Exp : Exp = a.Exp.spot, Row_ [a, b]) (Spot.nil, Nat 0) s 282 | 283 | row_seq : Exp? *Exp = 284 | _, Row [a, b]? a, row_seq b 285 | _, Nat 0? 0 286 | a? Fail.main2 $Fun a.str 287 | 288 | of_spot spot=path,line1,column1,line2,column2:Spot : *Exp = [(spot, Str path), (spot, Nat line1), (spot, Nat column1), (spot, Nat line2), (spot, Nat column2)] 289 | 290 | -------------------------------------------------------------------------------- /term.m: -------------------------------------------------------------------------------- 1 | # token, node, word, lexical form 2 | 3 | https://en.wikipedia.org/wiki/Term_(logic) 4 | 5 | # tag for Term and Seq 6 | tag term:0 : N = # hack! do not use tag integers > Any.data_vmaddr 7 | term.Mem.of.Mem.nat >= Any.data_vmaddr & term.Pair.cast.Row.at0 | term.Mem.of.Mem.nat 8 | 9 | item term:0 : 1 = # hack! 10 | term.Mem.of.Mem.nat >= Any.data_vmaddr & term.Pair.cast.Row.at1 | Cast.any 0 11 | 12 | eq x:Term y:Term : B = x,y . 13 | Z_, Z_? 1 14 | B, B? 1 15 | C_, C_? 1 16 | N, N? 1 17 | I, I? 1 18 | R_, R_? 1 19 | N, I? 1 # todo 20 | I, N? 1 # todo 21 | S_, S_? 1 22 | Str a, Str b? a == b # s-literal 23 | Real a, Real b? a == b # r-literal 24 | Tnat m, Tnat n? m == n # type of n-literals 25 | Nat m, Nat n? m == n # n-literal 26 | Name a, Name b? S.eq a b 27 | Tree r, Tree s? List.all2 r s Exp.eq 28 | Row r, Row s? List.all2 r s Exp.eq 29 | Pre _ t, Pre _ u? Exp.eq t u 30 | Post t _, Post u _? Exp.eq t u 31 | Binary p _ q, Binary t _ u? Exp.eq p t & Exp.eq q u 32 | # todo - Reg Flag 33 | Fact (eq (Exp.str_term '"foo"') (Str 'foo')) 34 | Fact (eq (Exp.str_term '1,2') (Exp.str_term '1,2')) 35 | Fact !(eq (Exp.str_term '1,2') (Exp.str_term '3,4')) 36 | Fact (eq (Exp.str_term 'Term') (Exp.str_term 'Term')) 37 | 38 | put x:Term = x.str.Put 39 | log x:Term = x.str.Log 40 | seq_str x:Terms : S = List.map_str x str 41 | seq_put x:Terms = List.map_put x str 42 | seq_log x:Terms = List.map_log x str 43 | 44 | flag_str : Flag? S = 45 | O? 'o' 46 | No? 'no' 47 | E? 'e' 48 | Ne? 'ne' 49 | S__? 's' 50 | Ns? 'ns' 51 | P? 'p' 52 | Np? 'np' 53 | L? 'l' 54 | Ge? 'ge' 55 | Le? 'le' 56 | G? 'g' 57 | x? Fail.main2 $Fun x.Cast.nat.N.str 58 | Fact (flag_str S__ == 's') 59 | 60 | reg_str : Reg? S = 61 | A? 'a' 62 | Ah? 'ah' 63 | B_? 'b' 64 | Bh? 'bh' 65 | C? 'c' 66 | Ch? 'ch' 67 | D? 'd' 68 | Dh? 'dh' 69 | Sp? 'sp' 70 | Bp? 'bp' 71 | Si? 'si' 72 | Di? 'di' 73 | R8? 'r8' 74 | R9? 'r9' 75 | R10? 'r10' 76 | R11? 'r11' 77 | R12? 'r12' 78 | R13? 'r13' 79 | R14? 'r14' 80 | R15? 'r15' 81 | Xmm0? 'xmm0' 82 | Xmm1? 'xmm1' 83 | x? Fail.main2 $Fun x.Cast.nat.N.str 84 | 85 | str : Term? S = 86 | Flag x? flag_str x 87 | Reg x? reg_str x 88 | Char x? C.code x 89 | Nat x? N.str x 90 | Tnat x? '#' + x.N.str 91 | Name x? x 92 | Name2 x y? Name.dot x y 93 | Str x? S.code x 94 | Real x? R.str x 95 | Mem n,x? Mem.hex x n 96 | Level x? '$' + x.N.str 97 | Tree s? '(' + s.Exp.seq_str + ')' 98 | Listx s? '[' + s.Exp.seq_str + ']' 99 | Listy s? '[' + s.Exp.row_seq.Exp.seq_str_seq + ']' 100 | Meta x? '[' + x + ']' 101 | Terms s? '(' + s.Term.seq_str + ')' 102 | Row s? '(' + s.Exp.seq_str_pair + ')' 103 | Key x y? x + ':' + str y 104 | Map s? '(' + Map.map_str s Fun.id str + ')' 105 | Pre o a? S.fill '($s $s)' [o, a.str] 106 | Post a o? S.fill '($s $s)' [a.str, o] 107 | Binary a o b? S.fill '($s$s$s$s$s)' [a.str, (o.Group.op_lean & '' | ' '), o, (o == ';' & 0a.C.str | ' '), b.str] 108 | Op x? x 109 | Add? 'add' 110 | And? 'and' 111 | Xor? 'xor' 112 | Or? 'or' 113 | Sub? 'sub' 114 | Cmp? 'cmp' 115 | Shl? 'shl' 116 | Shr? 'shr' 117 | Mul? 'mul' 118 | Div? 'div' 119 | Mod? 'mod' 120 | Neg? 'neg' 121 | Call? 'call' 122 | Enter? 'enter' 123 | Leave? 'leave' 124 | J? 'j' 125 | Mov? 'mov' 126 | Movsx? 'movsx' 127 | Lea? 'lea' 128 | Test? 'test' 129 | Not? 'not' 130 | Push? 'push' 131 | Pop? 'pop' 132 | Ret? 'ret' 133 | Syscall? 'syscall' 134 | Rdtsc? 'rdtsc' 135 | Cpuid? 'cpuid' 136 | Set_? 'set' 137 | Pause? 'pause' 138 | Xchg? 'xchg' 139 | Cmpxchg? 'cmpxchg' 140 | Base? '+' 141 | Span? ',' 142 | Label? "\.@" 143 | New? '$' 144 | A? 'a' 145 | Ah? 'ah' 146 | B_? 'b' 147 | Bh? 'bh' 148 | C? 'c' 149 | Ch? 'ch' 150 | D? 'd' 151 | Dh? 'dh' 152 | Sp? 'sp' 153 | Bp? 'bp' 154 | Si? 'si' 155 | Di? 'di' 156 | R8? 'r8' 157 | R9? 'r9' 158 | R10? 'r10' 159 | R11? 'r11' 160 | R12? 'r12' 161 | R13? 'r13' 162 | R14? 'r14' 163 | R15? 'r15' 164 | Xmm0? 'xmm0' 165 | Xmm1? 'xmm1' 166 | Z_? 'Z' 167 | B? 'B' 168 | C_? 'C' 169 | N? 'N' 170 | I? 'I' 171 | N0? 'N0' 172 | N1? 'N1' 173 | N2? 'N2' 174 | S_? 'S' 175 | R_? 'R' 176 | x? Fail.main2 $Fun x.N.str 177 | # Fact (str Z_ == 'Z') # fixme Type.class 178 | Fact (Flag O . str == 'o') 179 | 180 | lower : S? !Term = 181 | 'o'? Flag O 182 | 'no'? Flag No 183 | 'e'? Flag E 184 | 'ne'? Flag Ne 185 | 's'? Flag S_ 186 | 'ns'? Flag Ns 187 | 'p'? Flag P 188 | 'np'? Flag Np 189 | 190 | 'l'? Flag L 191 | 'ge'? Flag Ge 192 | 'le'? Flag Le 193 | 'g'? Flag G 194 | 'sl'? Flag Sl 195 | 'sge'? Flag Sge 196 | 'sle'? Flag Sle 197 | 'sg'? Flag Sg 198 | 199 | 'a'? Reg A 200 | 'b'? Reg B_ 201 | 'c'? Reg C 202 | 'd'? Reg D 203 | 'ah'? Reg Ah 204 | 'bh'? Reg Bh 205 | 'ch'? Reg Ch 206 | 'dh'? Reg Dh 207 | 'sp'? Reg Sp 208 | 'bp'? Reg Bp 209 | 'si'? Reg Si 210 | 'di'? Reg Di 211 | 'r8'? Reg R8 212 | 'r9'? Reg R9 213 | 'r10'? Reg R10 214 | 'r11'? Reg R11 215 | 'r12'? Reg R12 216 | 'r13'? Reg R13 217 | 'r14'? Reg R14 218 | 'r15'? Reg R15 219 | 'xmm0'? Reg Xmm0 220 | 'xmm1'? Reg Xmm1 221 | 222 | 'add'? Add 223 | 'or'? Or 224 | 'and'? And 225 | 'sub'? Sub 226 | 'xor'? Xor 227 | 'shl'? Shl 228 | 'shr'? Shr 229 | 230 | 'cmp'? Cmp 231 | 'mul'? Mul 232 | 'div'? Div 233 | 'mod'? Mod 234 | 'neg'? Neg 235 | 'call'? Call 236 | 'j'? J 237 | 'mov'? Mov 238 | 'movsx'? Movsx 239 | 'lea'? Lea 240 | 'test'? Test 241 | 'push'? Push 242 | 'pop'? Pop 243 | 'ret'? Ret 244 | 'syscall'? Syscall 245 | 'rdtsc'? Rdtsc 246 | 'cpuid'? Cpuid 247 | 'set'? Set_ 248 | 'pause'? Pause 249 | 'xchg'? Xchg 250 | 'cmpxchg'? Cmpxchg 251 | 252 | # floating number - whole, fractional, exponent 253 | # of_num nat:!N frac:!N s:S line:N : !S, N, !Term = 254 | of_nat s:S : S, N = 255 | r = S.cut_by s+1 C.is_dec 256 | r, S.nat (S.span s r) 257 | Fact (x = '42foo'; of_nat x == x+2,42) 258 | 259 | of_num s:S : Term, S = 260 | real, r = S.cut_num s 261 | (real & Real (R.of (S.span s r)) | Nat (S.nat (S.span s r))), r 262 | Fact (x = '42foo'; y, s = of_num x; s == x+2 & eq y (Nat 42)) 263 | Fact (x = '3.1415 foo'; y, s = of_num x; s == x+6 & eq y (Real '3.1415'.R.of)) 264 | 265 | neg : Term? Term = 266 | x? x 267 | 268 | # : in:S, line_increment:N, term 269 | of s:S line:N : !S, N, !Term = 270 | x = s & s.S.char | 0 271 | | x == 0 & 0, 0, 0 272 | | x == \! & 0, 0, 0 273 | | x == \; & s + 1, 0, 0 274 | | x == 0a & s + 1, 1, 0 275 | | x == \ & of s+1 line 276 | # | x == \- & # neg literal numbers 277 | | x == \+ & s + 1, 0, Base 278 | | x == \, & s + 1, 0, Span 279 | | x == \@ & s + 1, 0, Label 280 | | x == \# & of (S.cut s+1 0a) line 281 | | x == \' & (r, n = S.cut_line s+1 \' 0; r + 1, n, Str (S.span s+1 r)) 282 | # | x == \0 & (r = S.cut_by s+1 C.is_hex; r, 0, Nat (S.hex (S.span s+1 r))) 283 | | x == \0 & 284 | | S.char s+1 == \' & 285 | r, n = S.cut_line s+2 \' 0 286 | r + 1, n, Mem_ (Mem.of_hex (S.span s+2 r)) 287 | | 288 | r = S.cut_by s+1 C.is_hex 289 | r, 0, Nat (S.hex (S.span s+1 r)) 290 | # | C.is_digit x & (r = S.cut_by s+1 C.is_dec; r, 0, Nat (S.nat (S.span s r))) 291 | | C.is_digit x & (y, r = of_num s; r, 0, y) 292 | | C.is_lo_upper x & (r = S.cut_by s+1 C.is_name; r, 0, Name (S.span s r)) 293 | | C.is_lower x & 294 | r = S.cut_by s+1 C.is_name 295 | r, 0, (lower (S.span s r) | Fail.main3 (N.str line) 'str_term invalid term lower' (S.span s r)) 296 | | Fail.main3 line.N.str 'str_term' x.C.str 297 | 298 | Fact (s, n, x = of '42' 0; eq x (Nat 42)) 299 | Fact (s, n, x = of '3.1415' 0; eq x (Real 3.1415)) 300 | Fact (s, n, x = of '02a' 0; eq x (Nat 42)) 301 | Fact (n, x = of "0'63616665'" 0 . 2 . Term.Mem_term; n == 4 & Mem.get0 x == 063 & Mem.get0 x+1 == 061 & Mem.get0 x+2 == 066 & Mem.get0 x+3 == 065) 302 | Fact (s, n, x = of "'foo'" 0; eq x (Str 'foo')) 303 | 304 | of1 s:S : S = (_, _, x = of s 0; x & str x | '') 305 | Fact (of1 '42' == '42') 306 | Fact (of1 'a' == 'a') 307 | Fact (of1 '+' == '+') 308 | Fact (Binary (0, Nat 13) '+' (0, Nat 42) . str == '(13 + 42)') 309 | 310 | of_exp spot,m:Exp : Term = m . 311 | Name x? S.is_capital x & Name x | (lower x | Exp.seq_error $Fun 'invalid name' [(spot,m)]) # labels from main.ma - Data_vmend, Code_vmaddr, Code_vmend 312 | Name2 x y? Name x+'.'+y 313 | x? x 314 | 315 | Flag_term x:Term : N = x.Pair.cast.Row.at1.Cast.any 316 | Reg_term x:Term : N = x.Pair.cast.Row.at1.Cast.any 317 | Char_term x:Term : C = x.Pair.cast.Row.at1.Cast.any 318 | Nat_term x:Term : N = x.Pair.cast.Row.at1.Cast.any 319 | Real_term x:Term : R = x.Pair.cast.Row.at1.Cast.any 320 | Mem_term x:Term : N, Mem = x.Pair.cast.Row.at1.Cast.any 321 | Tnat_term x:Term : N = x.Pair.cast.Row.at1.Cast.any 322 | Str_term x:Term : S = x.Pair.cast.Row.at1.Cast.any 323 | Name_term x:Term : S = x.Pair.cast.Row.at1.Cast.any 324 | Name2_term x:Term : S, S = x.Pair.cast.Row.at1.Cast.any 325 | Op_term x:Term : S = x.Pair.cast.Row.at1.Cast.any 326 | Level_term x:Term : N = x.Pair.cast.Row.at1.Cast.any 327 | Tree_term x:Term : Exps = x.Pair.cast.Row.at1.Cast.any 328 | Listx_term x:Term : Exps = x.Pair.cast.Row.at1.Cast.any 329 | Listy_term x:Term : Exp = x.Pair.cast.Row.at1.Cast.any 330 | Meta_term x:Term : S = x.Pair.cast.Row.at1.Cast.any 331 | Pre_term x:Term : S, Exp = x.Pair.cast.Row.at1.Cast.any 332 | Post_term x:Term : Exp, S = x.Pair.cast.Row.at1.Cast.any 333 | Binary_term x:Term : Exp, S, Exp = x.Pair.cast.Row.at1.Cast.any 334 | Row_term x:Term : Exps = x.Pair.cast.Row.at1.Cast.any 335 | Key_term x:Term : S, Term = x.Pair.cast.Row.at1.Cast.any 336 | Terms_term x:Term : Terms = x.Pair.cast.Row.at1.Cast.any 337 | Map_term x:Term : *(S, Term) = x.Pair.cast.Row.at1.Cast.any 338 | 339 | # do not use [X = 0] to reserve it for optional type 340 | Flag_tag = 1 341 | Reg_tag = 2 342 | Char_tag = 3 343 | Nat_tag = 4 344 | Str_tag = 5 345 | Name_tag = 6 346 | Op_tag = 7 347 | Level_tag = 8 348 | Tree_tag = 9 349 | Listx_tag = 10 350 | Listy_tag = 11 351 | Meta_tag = 12 352 | 353 | Tnat_tag = 89 354 | Next_tag = 90 355 | Def_tag = 91 356 | 357 | Type_tag = 92 358 | At_tag = 93 359 | Fun_tag = 94 360 | Pair_tag = 95 361 | By_tag = 96 362 | Mod_tag = 97 363 | Pow_tag = 98 364 | 365 | Pre_tag = 110 366 | Post_tag = 111 367 | Binary_tag = 112 368 | Row_tag = 113 369 | Name2_tag = 114 370 | Key_tag = 115 371 | Terms_tag = 116 372 | Map_tag = 117 373 | Node_tag = 118 374 | 375 | # Z_ = 120 376 | # N0 = 130 377 | Real_tag = 150 378 | Mem_tag = 151 379 | 380 | # sequence types 381 | Sstr_tag = 200 382 | Slist_tag = 201 383 | Srow_tag = 202 384 | Sfun_tag = 203 385 | Slink_tag = 204 386 | Smap_tag = 205 387 | Sseq_tag = 206 388 | Sskip_tag = 207 389 | Stake_tag = 208 390 | Skeep_tag = 209 391 | Spair_tag = 210 392 | Sadd_tag = 211 393 | Sone_tag = 212 394 | 395 | Snil_term x:+0 : Z = 0 396 | Sskip_term x:+0 : N, +0 = x.Pair.cast.Row.at1.Cast.any 397 | Stake_term x:+0 : N, +0 = x.Pair.cast.Row.at1.Cast.any 398 | Slist_term x:+0 : *0 = x.Pair.cast.Row.at1.Cast.any 399 | #Sstr_term x:+C : S, S = x.Pair.cast.Row.at1.Cast.any 400 | Sstr_term x:+C : N, S = x.Pair.cast.Row.at1.Cast.any 401 | #Srow_term x:+0 : Mem Mem = x.Pair.cast.Row.at1.Cast.any # 0^ 0^ 402 | Srow_term x:+0 : N, Mem = x.Pair.cast.Row.at1.Cast.any 403 | Sfun_term x:+0 : !N, Z?!0 = x.Pair.cast.Row.at1.Cast.any 404 | Slink_term x:+0 : 0, +0 = x.Pair.cast.Row.at1.Cast.any 405 | Sone_term x:+0 : 0 = x.Pair.cast.Row.at1.Cast.any 406 | Sadd_term x:+0 : +0, +0 = x.Pair.cast.Row.at1.Cast.any 407 | Smap_term x:+1 : 0?1, +0 = x.Pair.cast.Row.at1.Cast.any 408 | Skeep_term x:+1 : 0?B, +0 = x.Pair.cast.Row.at1.Cast.any 409 | Sseq_term x:+0 : *+0 = x.Pair.cast.Row.at1.Cast.any 410 | Spair_term x:+(0,1) : +0, +1 = x.Pair.cast.Row.at1.Cast.any 411 | -------------------------------------------------------------------------------- /seq.m: -------------------------------------------------------------------------------- 1 | # sequence, container, collection, generator 2 | 3 | https://en.wikipedia.org/wiki/Collection_(abstract_data_type) 4 | https://en.wikipedia.org/wiki/Stream_(computing) 5 | 6 | str0 skip:N take:!N : +C? S = 7 | Sstr n s? s 8 | Sskip n s? str0 skip+n take s 9 | Stake n s? str0 skip (N.opt n) s 10 | ? Fail $Fun 11 | str_char s:+C : S = str0 0 0 s 12 | Fact (str_char 'foo'.S.seq == 'foo') 13 | 14 | size : +0? N = 15 | Sskip n s? size s - n 16 | Stake n s? N.min s.size n 17 | Slist s? List.size s 18 | Sstr n _? n 19 | # Srow r s? s - r 20 | Srow n s? n 21 | Sfun n f? n | 0 # fixme, opt return 22 | Slink x s? 1 + size s 23 | Sadd r s? size r + size s 24 | Smap _ s? size s 25 | Sseq s? List.map_sum_nat s size 26 | 27 | # bound : +0? N 28 | 29 | row3 s:0,0,0 : +0 = Srow 3 s.Cast.any 30 | 31 | Fact (size 'foo'.S.seq == 3) 32 | Fact (Sskip 1 'foo'.S.seq . size == 2) 33 | Fact (Stake 2 'foo'.S.seq . size == 2) 34 | Fact (Stake 5 'foo'.S.seq . size == 3) 35 | Fact (size (row3 2,3,5) == 3) 36 | Fact (size Slist[13, 42] == 2) 37 | Fact (size (Slink 3 Slist[5, 13]) == 3) 38 | Fact (size (Smap N.tick Slist[13, 42]) == 2) 39 | Fact (size (Sseq [Slist[1, 2], Slist[3, 5, 8]]) == 5) 40 | 41 | do_fun f:0?Z g:Z?!0 : Z = 42 | x = g 0 43 | x & (f x.N.must; do_fun f g) 44 | 45 | # producer yield 46 | pump : +0? Z? !0 = 47 | # Sstr n s? S.pump s : Z?!0 48 | Sstr _ s? (S.pump s : Z?!0) 49 | ? Fail $Fun 50 | Fact (x = pump 'foo'.S.seq; !x == N.opt \f & x 0 == N.opt \o & x 0 == N.opt \o) 51 | 52 | do f:0?_ : +0? Z = 53 | Sstr n s? S.do f s n 54 | Slink x s? (f x; do f s) 55 | Sone x? f x 56 | Sadd r s ? (do f r; do f s) 57 | Sseq s? List.do s (do f) 58 | Slist s? List.do s f 59 | Srow n s? Row.do f s n 60 | Spair r s? (g = pump r; do ((_ f_:1,2?_ g_:Z?!1 y:2 : Z = (x = g_ 0; x & f_ x.N.must,y)) f g) s) # Rewrite.NAME_BUG 61 | Smap g s? do (Fun.of f g) s 62 | Skeep g s? do ((_ g_:1?B f_:0?_ x:2 : Z = g_ x & f_ x) g f) s 63 | Sfun _ g? do_fun f g 64 | 0? 0 65 | x? Fail.main2 $Fun x.Term.tag.N.str 66 | Fact (x = %0; do (Ref.add x) 'foo'.S.seq; !x == \f + \o + \o) 67 | Fact (x = %0; do (Ref.add x) Slist[2, 3, 5]; !x == 10) 68 | Fact (x = %0; do (Ref.add x) (Sadd Slist[2, 3, 5] Slist[8, 13]); !x == 31) 69 | Fact (x = %0; do (Ref.add x) (Sadd Slist[2, 3, 5] Slist[8, 13, 21]); !x == 52) 70 | Fact (x = %0; do (Ref.add x) (row3 2,3,5); !x == 10) 71 | Fact (x = %0; do (Ref.add x) (Smap N.tick Slist[2, 3]); !x == 7) 72 | Fact (x = %0; do (Ref.add x) (Skeep N.odd Slist[2, 3, 5]); !x == 8) 73 | Fact (s = %0; do (_ x,y:C,C : Z = Ref.add s y-x) (Spair 'abc'.S.seq 'def'.S.seq); !s == 9) 74 | Fact (s = %0; do (_ x,y:C,C : Z = Ref.add s y-x) (Spair 'abc'.S.seq 'de'.S.seq); !s == 6) 75 | Fact (s = %0; do (_ x,y:C,C : Z = Ref.add s y-x) (Spair 'ab'.S.seq 'def'.S.seq); !s == 6) 76 | Fact (s = %0; do (_ x,y:C,C : Z = Ref.add s y-x) (Spair 'ab'.S.seq ''.S.seq); !s == 0) 77 | Fact (do S.size (Smap List.head Slist[['foo']]); 1) 78 | Fact (x = %0; do (Ref.add x) (Sfun 3 (tick 3)); !x == 3) 79 | 80 | # skip/take span range slice interval 81 | do_span0 skip:N take:!N f:0?_ : +0? Z = # do_span skip take 82 | Sskip n s? do_span0 skip+n take f s 83 | Stake n s? do_span0 skip (N.opt n) f s 84 | Sstr n s? S.do f s+skip (Opt.min take n)-skip 85 | Spair r s? (g = pump r; do_span0 skip take ((_ f_:1,2?_ g_:Z?!1 y:2 : Z = (x = g_ 0; x & f_ x.N.must,y)) f g) s) # Rewrite.NAME_BUG 86 | Slist s? List.do s.(List.skip skip).(Opt.map2 N.must (Opt.map take (N.sub2 skip)) List.take) f 87 | #Srow n s? Row.do f s n 88 | Smap g s? do_span0 skip take (Fun.of f g) s 89 | Skeep g s? do_span0 skip take ((_ g_:1?B f_:0?_ x:2 : Z = g_ x & f_ x) g f) s 90 | Sseq s? List.do s (do_span0 skip take f) 91 | #Sfun _ g? do_fun f g 92 | ? Fail $Fun 93 | do_span f:0?_ s:+0 = do_span0 0 0 f s 94 | Fact (x = %0; do_span (Ref.add x) (Sskip 1 'foo'.S.seq); !x == \o + \o) 95 | Fact (x = %0; do_span (Ref.add x) (Stake 2 'foo'.S.seq); !x == \f + \o) 96 | Fact (x = %0; do_span (Ref.add x) (Smap N.tick 'foo'.S.seq); !x == \f+1 + \o+1 + \o+1) 97 | Fact (x = %0; do_span (Ref.add x) ('foo'.S.seq . Smap N.tick . Sskip 1); !x == \o+1 + \o+1) 98 | Fact (x = %0; do_span (Ref.add x) ('foo'.S.seq . Sskip 1 . Smap N.tick); !x == \o+1 + \o+1) 99 | Fact (x = %0; do_span (Ref.add x) (Skeep N.odd Slist[2, 3, 5]); !x == 8) 100 | Fact (s = %0; do_span (_ x,y:C,C : Z = Ref.add s y-x) (Stake 2 (Spair 'abc'.S.seq 'def'.S.seq)); !s == 6) 101 | Fact (s = %0; do_span (_ x,y:C,C : Z = Ref.add s y-x) (Spair 'abc'.S.seq 'def'.S.seq.(Stake 2)); !s == 6) 102 | 103 | sum_seq f:0?1?1 a:1 s:*+0 : 1 = s & sum f (sum_seq f a s.List.tail) s.List.head | a # similar to List.flat = sum add 104 | 105 | sum_fun f:0?1?1 a:1 g:Z?!0 : 1 = 106 | x = g 0 107 | x & sum_fun f (f x.N.must a) g | a 108 | 109 | # pair/cons fold aggregate 110 | # https://wiki.haskell.org/Foldl_as_foldr 111 | # https://wiki.haskell.org/Foldr_Foldl_Foldl' 112 | sum f:0?1?1 a:1 : +0? 1 = 113 | Sstr n s? S.fold f a s n 114 | Sone x? f x a 115 | Sadd r s? sum f (sum f a s) r 116 | Slist s? List.sum_right s f a 117 | Srow n s? Row.fold f a s n 118 | Spair r s? (z = pump r; sum ((_ f_:1,2?3?3 z_:Z?!1 y:2 a_:3 : 3 = (x = z_ 0; x & f_ x.N.must,y a_ | a_)) f z) a s) 119 | Smap g s? sum ((_ g_:2?0 f_:0?1?1 x:2 a_:1 : 1 = f_ (g_ x) a_) g f) a s 120 | Skeep g s? sum ((_ g_:1?B f_:0?1?1 x:2 a_:1 : 1 = g_ x & f_ x a_ | a_) g f) a s 121 | Sfun _ g? sum_fun f a g 122 | Sseq s? sum_seq f a s 123 | # Snil _? a 124 | 0? a 125 | x? Fail.main2 $Fun x.Term.tag.N.str 126 | 127 | Fact (sum N.add 0 'foo'.S.seq == \f + \o + \o) 128 | Fact (sum N.add 0 Slist[2, 3, 5] == 10) 129 | Fact (sum N.add 0 (row3 2,3,5) == 10) 130 | Fact (sum N.min N.max3 Slist[3, 2, 13, 5] == 2) 131 | Fact (sum N.max 0 Slist[2, 3, 13, 5] == 13) 132 | Fact (sum N.add 0 (Skeep N.odd Slist[2, 3, 5]) == 8) 133 | Fact (sum (_ x,y:C,C s:N : N = s + y-x) 0 (Spair 'abc'.S.seq 'def'.S.seq) == 9) 134 | 135 | # http://okmij.org/ftp/Streams.html#1enum2iter Parallel composition of iteratees: one source to several sinks 136 | sum_size f:0?1?1 a:1 s:+0 : 1, N = sum ((_ f_:0?1?1 x:0 a,n:1,N : 1, N = f_ x a, n+1) f) a,0 s 137 | # Fact (sum_size N.add 42 Slist[] == 42,0) # FIX_TYPE_ANNOTATE 138 | Fact (sum_size N.add 42 Slist([]:*N) == 42,0) 139 | Fact (sum_size N.add 0 Slist[2, 3, 5] == 10,3) 140 | 141 | sum_nat s:+N : N = sum N.add 0 s 142 | Fact (sum_nat Slist[2, 3, 5] == 10) 143 | 144 | sum_size_nat s:+N : N, N = sum_size N.add 0 s 145 | Fact (sum_size_nat Slist[2, 3, 5] == 10,3) 146 | 147 | #mean s:+N : R = sum_nat s / size s 148 | Fact (sum_nat Slist[2, 3, 5] == 10) 149 | 150 | # while/break, short circuit, early termination 151 | # todo - need another function for returning B,1 152 | # list anamorphism [Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire] 153 | sum_opt f:1?0?!1 a:1 opt:1?!1 must:!1?1 : +0? !1 = 154 | Sstr _ s? S.sum_opt f a s opt must 155 | Slist s? List.sum_opt f a s opt must 156 | Smap g s? sum_opt ((_ g_:2?0 f_:1?0?!1 a_:1 x:2 : !1 = f_ a_ (g_ x)) g f) a opt must s 157 | Skeep g s? sum_opt ((_ g_:0?B f_:1?0?!1 opt_:1?!1 a_:1 x:0 : !1 = g_ x & f_ a_ x | opt_ a_) g f opt) a opt must s 158 | # Sfun _ g? sum_fun f a g 159 | # Sseq s? sum2 f a s 160 | ? Fail $Fun 161 | # Fact (sum_opt N.even.bit_opt 0 Slist[2, 4, 10] == Opt 0) # todo - Opt.eq 162 | Fact (Opt.eq_by Z.eq (sum_opt N.even.bit_opt 0 Z.opt Z.must Slist[2, 4, 10]) !Z.opt) 163 | Fact (sum_opt N.even.bit_opt 0 Z.opt Z.must Slist[2, 4, 7, 10] == 0) 164 | 165 | # paramorphisms 166 | sum_key f:1?0?!1 a:1 must:!1?1 : +0? B, 1 = 167 | #Sstr _ s? S.sum_key f a s 168 | Slist s? List.sum_key f a s must 169 | #Smap g s? sum_key ((_ g_:2?0 f_:1?0?!1 a_:1 x:2 : !1 = f_ a_ (g_ x)) g f) a s 170 | #Skeep g s? sum_key ((_ g_:1?B f_:0?1?!1 x:2 a_:1 : !1 = g_ x & f_ x a_ | a_) g f) a s 171 | # Sfun _ g? sum_fun f a g 172 | # Sseq s? sum2 f a s 173 | ? Fail $Fun 174 | Fact (sum_key N.even.bit_opt 0 Z.must Slist[2, 4, 10] == 1,0) 175 | Fact (sum_key N.even.bit_opt 0 Z.must Slist[2, 4, 7, 10] == 0,0) 176 | 177 | sum_at f:1?0?!1 a:1 opt:0?!0 s:+0 : N, !0, 1 = 178 | sum_key ((_ f_:1?0?!1 opt_:1?!1 i,x0,a:N,!0,1 x:0 : !(N, !0, 1) = (x0 & (i, x0, a) | (b = f_ a x; i+1, (!b & opt_ x):!0, b:1))) f opt) 0,0,a Opt.must s . Row.at1 179 | Fact (sum_at N.even.bit_opt 0 N.opt Slist[2, 4, 7, 10] == 3,7.N.opt,0) 180 | 181 | # find 182 | get opt:0?!0 must:!1?1 f:0?B s:+0 : !(N, 0) = 183 | i, x, _ = sum_at f.not.bit_opt 0 opt s 184 | x & (i, must x):!(N, 0) 185 | Fact (get N.opt N.must N.odd Slist[2, 4, 7, 10] == 3,7) 186 | bit_opt f:0?B : f:Z?0?!Z = (_ f_:0?B _:Z x:0 : !Z = f_ x . Opt.of) f 187 | 188 | bit_and f:0?B : f:0?B?B = (_ f_:0?B x:0 y:B : B = f_ x & y) f 189 | 190 | #not f:0?B : 0?B = (_ f_:0?B x:0 : B = !(f_ x)) f 191 | not f:0?B : 0?B = (_ f:0?B x:0 : B = !(f x)) f 192 | 193 | all f:0?B s:+0 : B = sum_opt f.bit_opt 0 Z.opt Z.must s . Opt.bit 194 | Fact (all C.is_lower 'foo'.S.seq) 195 | Fact !(all C.is_upper 'foo'.S.seq) 196 | Fact (all N.odd Slist[1, 3, 5]) 197 | Fact !(all N.odd Slist[1, 2, 5]) 198 | Fact !(all (N.le 5) (Skeep N.odd Slist[3, 10, 5])) 199 | Fact (all (N.gt 7) Slist[3, 5]) 200 | Fact (all (N.gt 7) (Skeep N.odd Slist[3, 10, 5])) 201 | Fact (all S.bit (Skeep S.bit Slist['foo', ''])) 202 | Fact !(all (_ x:Z?N : B = N.lt !x 3) Slist[(_ _ : N = 2), (_ _ : N = 5), (_ _ : N = !Fail.nil)]) 203 | Fact (Job.err (? all_full (_ x:Z?N : B = N.lt (x 0) 3) Slist[(_ _ : N = 2), (_ _ : N = 5), (_ _ : N = Fail 'foo')] . Z) == "foo: error \.") 204 | 205 | all_full f:0?B s:+0 : B = sum f.bit_and 1 s 206 | Fact (all_full N.odd Slist[1, 3, 5]) 207 | Fact !(all_full N.odd Slist[1, 2, 5]) 208 | 209 | # in has mem member 210 | any f:0?B s:+0 : B = sum_opt f.not.bit_opt 0 Z.opt Z.must s . Opt.bit . B.not 211 | Fact (any C.is_lower 'Foo'.S.seq) 212 | Fact !(any C.is_upper 'foo'.S.seq) 213 | Fact (any N.even Slist[1, 2, 5]) 214 | Fact !(any N.even Slist[1, 3, 5]) 215 | Fact (any (N.eq 5) (Skeep N.odd Slist[3, 10, 5])) 216 | Fact (any (_ x:Z?N : B = N.gt !x 3) Slist[(_ _ : N = 2), (_ _ : N = 5), (_ _ : N = !Fail.nil)]) 217 | Fact (any (N.lt 3) (Smap Fun.do (Slist[(_ _ : N = 2), (_ _ : N = 5), (_ _ : N = !Fail.nil)]))) 218 | 219 | any_full f:0?B s:+0 : B = sum f.not.bit_and 1 s . B.not 220 | Fact (any_full N.even Slist[1, 2, 5]) 221 | Fact !(any_full N.even Slist[1, 3, 5]) 222 | Fact (Job.err (? any_full (_ x:Z?N : B = N.gt !x 3) Slist[(_ _ : N = 2), (_ _ : N = 5), (_ _ : N = Fail 'foo')] . Z) == "foo: error \.") 223 | 224 | list s:+0 : *0 = sum List.main 0 s 225 | Fact (list 'foo'.S.seq == [\f, \o, \o]) 226 | Fact (list Slist[2, 3, 5] == [2, 3, 5]) 227 | Fact (list (Smap N.tick Slist[13, 42]) == [14, 43]) 228 | Fact (list (Sseq [Slist[1, 2], Slist[3, 5, 8], Slist[11, 13]]) == [1, 2, 3, 5, 8, 11, 13]) 229 | Fact (list (Sfun 3 (tick 3)) == [2, 1, 0]) 230 | Fact (list (Smap Fun.do Slist[(_ _ : N = 2), (_ _ : N = 5)]) == [2, 5]) 231 | Fact (list (Skeep N.odd Slist[2, 3, 5, 8]) == [3, 5]) 232 | 233 | tick n:N : Z? !N = 234 | i = %0 235 | (_ n_:N i_:%N _:Z : !N = (!i_ < n_ & Ref.tick0 i_ . N.opt)) n i 236 | Fact (f = tick 3; !f == N.opt 0 & !f == N.opt 1 & !f == N.opt 2 & !f == 0) 237 | 238 | row s:+0 : Mem = (n = s.size; r, f = Row.init n; do f s; r) 239 | Fact (row Slist[2, 3, 5] . Row.mem_eq3 2,3,5) 240 | Fact (row (Sseq [Slist[1, 2], Slist[3], Slist[5, 8]]) . Row.mem_eq5 1,2,3,5,8) 241 | Fact (row (Sfun 3 (tick 3)) . Row.mem_eq3 0,1,2) 242 | 243 | pop : +0? !(0, +0) = 244 | # Sstr n s? (S.pop s . (x, r? (x, (Sstr n-1 r : +0)))) 245 | Sstr n s? (S.pop s . (x, r? (x:0, (Sstr n-1 r : +0)))) # FIX_TYPE_ANNOTATE 246 | Slist s? (List.pop s . (x, r? x, Slist r)) 247 | # Srow n s? Row.do f s n 248 | # Spair r s? (z = pump r; do ((_ f_:1,2?_ z_:Z?!1 y:2 : Z = (x = z_ 0; x & f_ x.Opt.un,y)) f z) s) # FIXME - failed if [p] not [z] 249 | # Smap g s? do (Fun.of f g) s 250 | # Skeep g s? do ((_ g_:1?B f_:0?_ x:2 : Z = g_ x & f_ x) g f) s 251 | # Sseq s? List.do s (do f) 252 | # Sfun _ g? do_fun f g 253 | ? Fail $Fun 254 | Fact (x, s = pop Slist[13, 42]; x == 13 & list s == [42]) 255 | #Fact (pop 'foo'.S.seq == \f,'oo'.S.seq) # todo Seq.eq_by 256 | 257 | peek s:+0 : !0 = pop s . Opt.at0 258 | # Fact (peek Slist[] == 0) 259 | Fact (peek Slist([]:*N) == 0) 260 | Fact (peek Slist[13, 42] == 13) 261 | 262 | cores f:0?_ s:+0 opt:0?!0 must:!0?0 : Z = 263 | r = % list s 264 | Thread.all (_ _:N = Ref.do f r opt must) 265 | 0 266 | Fact (s = %0; cores (_ x:N = Ref.padd s x) 100.List.nat.Slist N.opt N.must; !s == 4950) # n(n+1)/2 = (99*100)/2 = 4950 267 | 268 | add r:+0 s:+0 : +0 = Sadd r s 269 | Fact (add Slist[2, 3, 5] Slist[8, 13] . list == [2, 3, 5, 8, 13]) 270 | Fact (Slist[2, 3, 5]+Slist[8, 13] . list == [2, 3, 5, 8, 13]) 271 | 272 | adds s:*+0 : +0 = List.sum add 0 s 273 | Fact (adds [Slist[2, 3, 5], Slist[8, 13]] . list == [2, 3, 5, 8, 13]) 274 | 275 | eq r:+0 s:+0 : B = N.eq r.Cast.any s.Cast.any 276 | Fact (eq 0 0) 277 | 278 | eq_by f:0?0?B r:+0 s:+0 : B = Fail $Fun # TODO 279 | 280 | map_line s:+0 f:0?S : S = List.map_line s.list f 281 | 282 | str_by f:0?S s:+0 : S = List.str_by f s.list 283 | -------------------------------------------------------------------------------- /rewrite.m: -------------------------------------------------------------------------------- 1 | # tree rewrite 2 | 3 | https://en.wikipedia.org/wiki/Rewriting 4 | 5 | # {| a; | b} --> a | {| b} 6 | # tree_bar recurses into tree_bar, not exps or exp, else: 7 | # | a; (| b; | c) 8 | # --> | a; op_if ... 9 | # but (| b; | c) is rewritten with op_if rule below, and that cannot be simplify further to have a | b | c 10 | # : Exps 11 | tree_bar : Exp? Exp = 12 | spot, Binary (_, Pre '|' a) ';' b? spot, Binary a '|' b 13 | a? a 14 | 15 | # a, (b, c) -> a, b, c 16 | # a, ((b, c)) -> a, (b, c) 17 | pair_row : Exp? Exps = 18 | _, Binary a ',' b? a, pair_row b 19 | _, Tree [a]? [a] # special for last node - a,b, c,d -> ((a, b), (c, d)) 20 | a? [a] 21 | 22 | pair_seq : Exp? Exp = 23 | spot, Binary a ',' b? spot, Row_ [a, b.pair_seq] 24 | _, Tree [a]? a 25 | a? a 26 | 27 | exps0 s:Exps : Exps = s exp 28 | 29 | exps s:Exps : Exps = s exp + !nameless_funs 30 | 31 | exp a:Exp : Exp = a.do_exp1.do_exp2 32 | 33 | do_exp1 exp=spot,term:Exp : Exp = 34 | term . 35 | Pre o a? spot, Pre o a.do_exp1 36 | Post a o? spot, Post a.do_exp1 o 37 | Binary a o b? o . 38 | ','? spot, Row_ (List.map (pair_row exp) do_exp1) # a, (b, c) -> a, b, c 39 | ? spot, Binary a.do_exp1 o b.do_exp1 40 | Tree [(_, Name 'List'), a]? spot, Listy a.pair_seq.do_exp1 41 | Tree s? spot, Tree do_exp1.s 42 | Row s? spot, Row_ do_exp1.s 43 | ? exp 44 | 45 | do_exps2 : Exps? Exps = 46 | (_, Tree r), s? do_exps2 r+s 47 | 48 | # x = f a 49 | # | x & ((y, z) = x; g y z) 50 | # | h 0 51 | # 52 | # --> 53 | # 54 | # f a . 55 | # (y, z)? g y z 56 | # ? h 0 57 | 58 | # match rule sequence - {(a? b; c) d} === eq {a} {d} & b | {c d} 59 | # if (a == d) b {c d} 60 | [(_, Binary (spot, Binary rule '?' body) ';' also), arg]? # ;-exp recursion 61 | bind, arg2 = Exp.bind_name arg 62 | else = spot, Tree [also, arg2] 63 | [exp (Rule.bind_exp bind (spot, Binary (Rule.rewrite rule body arg2) '|' else))] 64 | 65 | [(spot, Binary rule '?' body), arg]? # ;-exp base 66 | bind, arg2 = Exp.bind_name arg 67 | [exp (Rule.bind_exp bind (Rule.rewrite rule body arg2))] 68 | 69 | [(spot, Pre '?' body), arg]? # _?a -> ?a 70 | bind, arg2 = Exp.bind_name arg 71 | [exp (Rule.bind_exp bind (Rule.rewrite (spot, Name '_') body arg2))] 72 | 73 | s? s exp 74 | 75 | # seq of all bindings across ; - else, [x,y = a,b; c] -> [(x=a; y=b); c] not [x=a; (y=b; c)] 76 | do_exp_exps2 exp=spot,term:Exp : Exps = term . 77 | # https://en.wikipedia.org/wiki/Guard_(computer_science) 78 | # consecutive conditionals: | a; | b; | c --> a | (b | c) 79 | # {; (| 0 a) (| 0 b)} --> {| 0 (| a b)} 80 | Binary (_, Pre '|' _) ';' _? [do_exp2 (tree_bar exp)] 81 | 82 | Binary a ';' b? do_exp_exps2 a + do_exp_exps2 b 83 | 84 | Binary (_, Row s) '=' a? 85 | bind, body = Exp.bind_name a 86 | tests, binds = List.map_at s (Rule.test_bind_row body,!s) 0 . List.unzip # fixme - need tests? 87 | List.map (Opt.add bind binds.List.adds) do_exp2 88 | 89 | ? [do_exp_exp2 exp] 90 | 91 | do_exp2 exp:Exp : Exp = Opt.get (Exp.binary_exps ';' (do_exp_exps2 exp)) $Fun 92 | 93 | # https://en.wikipedia.org/wiki/Anonymous_function 94 | # https://en.wikipedia.org/wiki/Closure_(computer_programming) 95 | # https://en.wikipedia.org/wiki/Partial_application 96 | nameless_funs = %0 : %Exps 97 | 98 | arg_vars _,e:Exp : *S = e . 99 | Binary (_, Name x) ':' _? [x] 100 | # Binary (_, (Binary (_, Name x) ',' (_, Name y))) ':' _? [x, y] 101 | Binary (_, (Row s)) ':' _? List.map_opt_rev s (_ : Exp? !S = (_, Name x)? x) 102 | 103 | # todo 104 | # 1. ignore the function itself, need names in lexical scope during typing in Type.m to determine if f or X.f are free variable, todo for higher-order functions REWRITE_FREE_VARS_FUN 105 | # 2. also local top-level in the unit, such as Thread.lock in Thread.main REWRITE_FREE_VARS_LOCAL 106 | # 3. also need to done rewriting ((a . X) . y) -> X.y a in do_exp2 do_exp_exps2 before [free_vars], see REWRITE_UNIT_NAME 107 | # 4. need types of free variables to rewrite into full function def - f x:t in [do_exp_exp2] below 108 | # free_vars s:*S e=_,m:Exp : *S = m . 109 | # Rewrite.NAME_BUG: some varialbe names such as [p] with local functions cause crashes, or [h] in parameter 110 | free_vars s:*S e=_,m:Exp : *Exp = m . 111 | Name x & S.is_lower x? ! List.in S.eq s x & [e] 112 | Pre _ a? free_vars s a 113 | Post a _? free_vars s a 114 | Binary (_, Name _) '.' _? [] 115 | Binary (_, Binary (_, Name x) '=' a) ';' b? free_vars s a + free_vars x,s b 116 | Binary (_, Binary (_, Row r) '=' _) ';' a? free_vars (List.add (List.map_opt_rev r (_ : Exp? !S = (_, Name x)? x)) s) a 117 | Binary (_, Binary a '.' (_, Name x)) '.' (_, Name _) & S.is_capital x? free_vars s a # REWRITE_UNIT_NAME 118 | Binary (_, Binary (_, Tree (_, Name '_'),args) ':' _) '=' body? free_vars (List.add (List.map_add args arg_vars) s) body # inside function, same as REWRITE_NAMELESS below 119 | Binary a ':' _? free_vars s a 120 | Binary a _ b? List.add (free_vars s a) (free_vars s b) 121 | Tree _,r? List.map_add r (free_vars s) 122 | Row r? List.map_add r (free_vars s) 123 | _? [] 124 | 125 | do_exp_exp2 spot,term:Exp : Exp = term . 126 | Pre '|' a? do_exp2 a # | a -> a 127 | 128 | Pre '?' body? # nameless local function 129 | free = free_vars [] body 130 | args = [(spot, Binary (spot, Name '_') ':' (spot, Name '_'))] 131 | all_args = (free & List.map free (_ x:Exp : Exp = spot, Binary x ':' (spot, Name 'Any'))) + args 132 | name = spot, Name 'f'.S.tick 133 | #free & (Tree name,all_args) . Term.log 134 | Ref.seq_add nameless_funs 135 | do_exp2 # f _:_ : 0 = a where the type is Any, not Z 136 | spot, Binary 137 | spot, Binary 138 | spot, Tree name,all_args 139 | ':' 140 | (spot, Name 'Z') 141 | '=' 142 | body 143 | # free & (spot, Tree name,free | name) . Exp.log 144 | free & spot, Tree name,free | name # f x:t y:u @ free y 145 | 146 | Pre '$' a=(spot2, Str _)? spot, Row_ [(spot, Pre '$' (spot2, Name 'Spot')), a] # $'foo' -> $Spot, 'foo' 147 | 148 | Pre o a? spot, Pre o (do_exp2 a) 149 | 150 | # see REWRITE_REAL2 for disabling this rewrite 151 | # Post (_, Nat x) '.'? spot, Real (R.of1 x) # REWRITE_REAL 152 | 153 | Post a o? spot, Post (do_exp2 a) o 154 | 155 | Listy a? spot, Listy (do_exp2 a) 156 | 157 | Tree (_, Binary (_, Name 'List') '.' (_, Name 'adds_')),s? # TYPE_VARARG - List.adds_ a b c -> List.adds [a, b, c] 158 | do_exp2 (spot, Tree [(spot, Name2 'List' 'adds'), Exp.seq_row1 s+[(spot, Nat 0)]]) 159 | 160 | Tree (_, Binary (_, Name 'Seq') '.' (_, Name 'adds_')),s? # TYPE_VARARG - Seq.adds_ a b c -> Seq.adds [a, b, c] 161 | do_exp2 (spot, Tree [(spot, Name2 'Seq' 'adds'), Exp.seq_row1 s+[(spot, Nat 0)]]) 162 | 163 | Tree (_, Binary (_, Name 'B') '.' (_, Name 'or')),s? # TYPE_VARARG - B.or a b c -> a | (b | c) 164 | do_exp2 (Opt.get (Exp.binary_exps '|' s) $Fun) 165 | 166 | Tree [a, (_, Name '²')]? do_exp2 (spot, Binary a '^' (spot, Real 2.)) # a² -> a^2 167 | Tree [a, (spot2, Name '√'), b]? do_exp2 (spot, Binary a '*' (spot, Tree [(spot2, Name2 'R' '√'), b])) # a√b -> a * (√b) 168 | Tree [a, (spot2, Name 'ϕ'), b]? do_exp2 (spot, Binary a '*' (spot, Tree [(spot2, Name2 'R' 'ϕ'), b])) # aϕb -> a * (ϕb) 169 | 170 | Tree s? Group.exps_exp (do_exps2 s) 171 | 172 | # cannot use [y] to represent the fractional part of a real due to leading zeros, else: 0.0016 becomes 0,016 -> 0.22 173 | # Binary (_, Nat x) '.' (_, Nat y)? spot, Real (R.of2 x y) # REWRITE_REAL2 174 | 175 | # unit fullname X . y -> X.y 176 | Binary (_, Name x) '.' (_, Name y) & S.is_capital x? spot, Name2 x y 177 | 178 | # REWRITE_UNIT_NAME long unit fullname a.X.y -> ((a . X) . y) -> X.y a 179 | Binary (_, Binary a '.' (_, Name x)) '.' (_, Name y) & S.is_capital x? Group.exps_exp (do_exps2 [(spot, Name2 x y), a]) 180 | 181 | # REWRITE_INFIX 182 | # a .f b -> (a (. f) b) -> f a b 183 | # f a b . g d e -> (f a b (. g) d e) -> (g (f a b) d e) 184 | 185 | # reverse apply 186 | # x.f -> f x 187 | # f a b . g d e -> (g d e (f a b)) 188 | Binary a '.' b? Group.exps_exp (do_exps2 [b, a]) 189 | 190 | # generated by Rule.tests_binds, but not user source code 191 | Binary (_, Binary a '&' b) '|' c? # a & b | c --> if a b c 192 | Group.exps_exp (do_exps2 [(spot, Name 'op_if'), a, b, c]) 193 | 194 | Binary a '|' b? # a | b -> x = a; if x x b 195 | # bind, c = Exp.bind_name a 196 | # exp (Rule.bind_exp bind (spot, Tree [(spot, Name 'op_if'), c, c, b])) 197 | do_exp2 (spot, Tree [(spot, Name 'op_if0'), a, b]) 198 | 199 | Binary a '&' b? # a & b --> if a b 0 200 | Group.exps_exp (do_exps2 [((spot, Name 'op_if')), a, b, (spot, Nat 0)]) 201 | 202 | Binary (spot2, Tree fun) '=' body? # default nil return type - f x:t = a -> f x:t = a 203 | do_exp2 (spot, Binary (spot2, Binary (spot2, Tree fun) ':' (spot2, Name 'Z')) '=' body) 204 | 205 | # todo, _ in multi args - f x:t _ : u = a -> f x:t _:Z : u = a 206 | Binary (spot1, Binary (spot2, Tree [name, (spot3, Name '_')]) ':' return) '=' body? # default nil argument type - f _ : t = a -> f _ : t = a 207 | do_exp2 (spot, Binary (spot1, Binary (spot2, Tree [name, (spot3, Binary spot3,Name'_' ':' spot3,Name'Z')]) ':' return) '=' body) 208 | 209 | # eta expand for match rule 210 | # {f = (a? b)} === {f x = (a? b) x} 211 | # {f = (a? b; c)} === {f x = (a? b; c) x} 212 | # f : t?u = (a? b) -> f x:t : u = (a? b) x 213 | Binary (_, Binary fun ':' (_, Binary arg_type '?' return_type)) '=' body & Exp.is_fun body? 214 | arg = spot, Name 'x'.S.tick 215 | typed_arg = spot, Binary arg ':' arg_type 216 | fun2 = fun.Exp.tree . 217 | Tree name_args? Tree name_args+[typed_arg] # f y.. x:t 218 | Name name? Tree [fun, typed_arg] # f x:t 219 | ? Exp.seq_error $Fun 'invalid fun' [(spot, term)] 220 | body2 = spot, Tree [body, arg] # (a? b) x 221 | do_exp2 (spot, Binary (spot, Binary (spot, fun2) ':' return_type) '=' body2) # f y.. x:t : u = (a? b) x 222 | 223 | Binary (_, Binary (_, Tree (_, Name '_'),args) ':' type) '=' body? # REWRITE_NAMELESS _ x:t : u = a -> f$n x:t : u = a 224 | name = spot, Name 'f'.S.tick 225 | free = free_vars (List.map_add args arg_vars) body 226 | all_args = (free & List.map free (_ x:Exp : Exp = spot, Binary x ':' (spot, Name 'Any'))) + args 227 | Ref.seq_add nameless_funs (spot, Binary (spot, Binary (spot, Tree name,all_args) ':' type) '=' body).do_exp2 228 | free & spot, Tree name,free | name # f x:t y:u @ free y 229 | 230 | # f x,y:t : u = a 231 | # f z:t : u = (x,y = z; a) 232 | Binary (_, Binary (_, Tree name,params) ':' return) '=' body? # todo - skip if params = simple var 233 | params2, bind_list = params Rule.binds . List.unzip 234 | body2 = Exp.binary_exps ';' bind_list.List.adds+[body] 235 | # todo - nto do_exp2 around the whole exp because the pattern is always applied (even without pair) 236 | spot, Binary (spot, Binary (spot, Tree name,params2).do_exp2 ':' return.do_exp2) '=' body2.do_exp2 237 | 238 | Binary a o b? spot, Binary (do_exp2 a) o (do_exp2 b) # [a; b] and [x,.. = a] already handled in do_exp_exps2 239 | 240 | Row s? spot, Row_ (s do_exp2) 241 | 242 | # todo - Name -> Str or Real 243 | Name '½'? spot, Real 1./2. 244 | Name '⅓'? spot, Real 1./3. 245 | Name '¼'? spot, Real 1./4. 246 | # Name 'ℯ'? spot, Real (R.exp 1.) 247 | # Name 'π'? spot, Real 3.14159265358979323846264338327950288 248 | 249 | ? spot, term 250 | 251 | Fact (1 . (1? 42) == 42) 252 | Fact (41,1 . (x, 1? x + 2) == 43) 253 | Fact (A . ((x = A)? x) == A) 254 | Fact (A . ((x = A)? x; (x = B_)? x) == A) 255 | Fact (B_ . ((x = A)? x; (x = B_)? x) == B_) 256 | 257 | of x:S : S = x.Exp.str_exps.Group.exps.exps.0.Exp.str 258 | 259 | Fact (of '42' == '42') 260 | 261 | Fact (of '"foo"' == "'foo'") 262 | Fact (of 'a' == 'a') 263 | 264 | Fact (of 'a+b' == '(a + b)') 265 | Fact (of 'a,b' == '(a,b)') 266 | Fact (of 'f a,b' == '(f (a,b))') 267 | 268 | Fact (of 'a,b' == '(a,b)') 269 | Fact (of 'a,b,c' == '(a,b,c)') 270 | Fact (of 'a,b, c,d' == '((a,b),(c,d))') 271 | Fact (of 'a,(b,c)' == '(a,(b,c))') 272 | Fact (of 'a, (f b, c)' == '(a,((f b),c))') 273 | Fact (of 'x = a, b' == '(x = (a,b))') 274 | 275 | Fact (of '[a,b]' == '[a, b]') 276 | Fact (of '[a,b,c]' == '[a, b, c]') 277 | Fact (of '[a,(b,c)]' == '[a, (b,c)]') 278 | Fact (of '[a,b, c,d]' == '[(a,b), (c,d)]') 279 | Fact (of '[0.a]' == '[(a 0)]') # rewrite after listy 280 | 281 | Fact (of 'a+b' == '(a + b)') 282 | Fact (of 'f a+b' == '(f (a + b))') 283 | --------------------------------------------------------------------------------