diff --git a/runtime/runtime.c b/runtime/runtime.c index 1729e8f0a..6fe55e987 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -4,12 +4,12 @@ # include "runtime.h" -# define __ENABLE_GC__ +# define __ENABLE_GC__ # ifndef __ENABLE_GC__ # define alloc malloc # endif -/* # define DEBUG_PRINT 1 */ +//# define DEBUG_PRINT 1 #ifdef DEBUG_PRINT int indent = 0; @@ -342,7 +342,7 @@ extern int LtagHash (char *s) { p = s; - while (*p && limit++ < 4) { + while (*p && limit++ <= 4) { char *q = chars; int pos = 0; @@ -2075,7 +2075,7 @@ extern void * alloc (size_t size) { #endif return p; } - + init_to_space (0); #ifdef DEBUG_PRINT print_indent (); diff --git a/src/Language.ml b/src/Language.ml index 2ff871f8c..693649d3d 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -802,6 +802,7 @@ module Expr = in (match arr with [a] -> a | _ -> Array (List.rev arr)), List.rev ss in + let escape = String.map (function '"' -> ' ' | x -> x) in List.fold_right (fun (loc, _, p, s) -> let make_right = match p with @@ -813,7 +814,7 @@ module Expr = ) in function - | Var "" -> Call (Var (infix_name "@"), [s; make_right sema]) + | Var "" -> Call (Var (infix_name "@@"), [Array [String (escape (show(t) s)); s]; make_right sema]) | acc -> Call (Var "seq", [s; make_right acc]) ) ss (Var "") }; diff --git a/src/version.ml b/src/version.ml index 039ae3462..c8b81e5a2 100644 --- a/src/version.ml +++ b/src/version.ml @@ -1 +1 @@ -let version = "Version 1.10, 669a4288d, Mon Nov 22 15:51:47 2021 +0300" +let version = "Version 1.10, f953814c7, Fri Dec 3 03:56:58 2021 +0300" diff --git a/stdlib/Collection.lama b/stdlib/Collection.lama index 2382a07b6..32713526e 100644 --- a/stdlib/Collection.lama +++ b/stdlib/Collection.lama @@ -308,35 +308,51 @@ public fun emptyCustomMemo (pred, compare) { } public fun emptyMemo () { --- ref (emptyMap (compare)) emptyCustomMemo ({}, compare) } public fun lookupMemo (mm@[p, m], v) { + var f = case v of + [Right, _] : _ -> true + | _ -> false + esac; + + if f then + skip -- printf ("Looked up 0x%.8x | 0x%.8x | %s\n", mm, v, v.string) + fi; + + case fun (x) { case p of #fun -> if p (v) then v else x () fi | _ -> x () - esac} - (fun () {case v of - #val -> v - | _ -> - case findMap (m, v) of - Some (w) -> w - | None -> - case v of - #str -> mm[1] := addMap (m, v, v); v - | _ -> - var vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac; - for skip, i < v.length, i := i + 1 do - var vci = lookupMemo (mm, vc [i]); - vc [i] := vci - od; - mm [1] := addMap (m, vc, vc); - vc - esac - esac - esac}) + esac + } + (fun () { + case v of + #val -> v + | _ -> + case findMap (m, v) of + Some (w) -> w + | None -> + case v of + #str -> mm[1] := addMap (m, v, v); v + | _ -> + var v0 = v; + var vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac; +-- printf ("Cloning: 0x%.8x\n", v); + for skip, i < v.length, i := i + 1 do + var vci = lookupMemo (mm, vc [i]); + vc [i] := vci + od; + mm [1] := addMap (m, vc, vc); + vc + esac + esac + esac}) of + r -> -- if f then printf ("Result | 0x%.8x | %s\n", r, r.string) fi; + r + esac } -- Maps of hashed pointers diff --git a/stdlib/Data.lama b/stdlib/Data.lama index e0ebd3cd0..fdaf3ec2b 100644 --- a/stdlib/Data.lama +++ b/stdlib/Data.lama @@ -7,6 +7,35 @@ import Collection; import Ref; -- Generic comparison for shared/cyclic data structures + +public fun trace (x) { + fun tracerec (s, x) { + case x of + #val -> skip -- printf ("unboxed:%d;", x) + | _ -> + if memSet (s, x) + then printf ("", x) + else + var s_ = addSet (s, x); + printf ("[0x%.8x: ", x); + case x of + #array -> printf ("a; ") + | #fun -> printf ("f<0x%.8x>; ", x[0]) + | #sexp -> printf ("s; ") + | #str -> printf ("c<%s>; ", x) + esac; + for var i = case x of #fun -> 1 | _ -> 0 esac;, i Succ (f (x), s) + | _ -> x + esac)}); +-- printf ("aa=%s\n", aa.string); +-- printf ("@@: %s\n", name); + aa (s) + } + } +} + public fun lift (f) { fun (x) {f} } @@ -294,7 +310,7 @@ public fun expr (ops, opnd) { {} -> fun (c) {opnd @ c} | level : tl -> var lops = altl (level), - next = inner (tl); + next = inner (tl); case level.fst of Nona ->