Updating: very very minorly

githwxi · Oct 5, 2024 · 64004f4 · 64004f4
1 parent 0a624ce
commit 64004f4
Show file tree

Hide file tree

Showing 7 changed files with 123 additions and 45 deletions.
diff --git a/srcgen2/DATS/trans23_dynexp.dats b/srcgen2/DATS/trans23_dynexp.dats
@@ -233,6 +233,12 @@ d3pat_make_tpnd
 |D2Pflat _ => f0_flat(env0, d2p0)
 |D2Pfree _ => f0_free(env0, d2p0)
 //
+(*
+HX-2024-10-04:
+[D2Pdap0] should have
+been eliminated at this point!
+*)
+|D2Pdap0 _ => f0_dap0(env0, d2p0)
 |D2Pdap1 _ => f0_dap1(env0, d2p0)
 |D2Pdapp _ => f0_dapp(env0, d2p0)
 //
@@ -343,11 +349,19 @@ d2con23_tjagize(loc0, d2c1)
 //
 val
 d3p0 =
-d3pat_make_node(loc0, D3Pcon(d2c1))
+(
+  d3pat_make_tpnd
+  (loc0, t2p0, D3Pcon(d2c1)))
 //
 in//let
+//
+case+ t2js of
+|list_nil _ => d3p0
+|list_cons _ =>
+(
   d3pat_make_tpnd
-  (loc0, t2p0, D3Ptapq(d3p0, t2js))
+  (loc0, t2p0, D3Ptapq(d3p0, t2js)))
+//
 end(*let*)//end-of-[f0_con(env0,d2p0)]
 //
 (* ****** ****** *)
@@ -464,6 +478,24 @@ end (*let*)//end-of-[f0_cons(env0,d2p0)]
 (* ****** ****** *)
 //
 fun
+f0_dap0
+( env0:
+! tr23env
+, d2p0: d2pat): d3pat =
+let
+//
+val loc0 = d2p0.lctn()
+//
+val tres = s2typ_none0()
+//
+in//let
+(
+d3pat(loc0, tres, D3Pnone1(d2p0)))
+end (*let*) // end of [f0_dap0(env0,d2p0)]
+//
+(* ****** ****** *)
+//
+fun
 f0_dap1
 ( env0:
 ! tr23env
@@ -2734,6 +2766,8 @@ val () =
 prerrsln("trans23_d3pat_tpck: d3p0 = ", d3p0)
 val () =
 prerrsln("trans23_d3pat_tpck: t2p0 = ", t2p0)
+val () = prerrsln("\
+trans23_d3pat_tpck: d3p0.styp() = ", d3p0.styp())
 *)
 //
 }(*where*) // end-of-[trans23_d3pat_tpck(...)]

diff --git a/srcgen2/DATS/trans23_utils0.dats b/srcgen2/DATS/trans23_utils0.dats
@@ -417,13 +417,11 @@ d3exp_make_node(loc0,D3Econ(dcon))
 in//let
 //
 case+ t2js of
-|
-list_nil _ =>
+|list_nil _ =>
 let
   val () = d3e0.styp(t2p0) in d3e0
 end // let // end of [list_nil(...)]
-|
-list_cons _ =>
+|list_cons _ =>
 (
   d3exp_make_tpnd
   (loc0, t2p0, D3Etapq(d3e0, t2js)) )

diff --git a/srcgen2/DATS/tread12_dynexp.dats b/srcgen2/DATS/tread12_dynexp.dats
@@ -997,22 +997,25 @@ d2p0.node() of
 |D2Pvar _ => d2p0
 |D2Pany _ => d2p0
 //
-|D2Pi00 _ => d2p0
-|D2Pb00 _ => d2p0
-|D2Pc00 _ => d2p0
-|D2Ps00 _ => d2p0
-//
 |D2Pint _ => d2p0
 |D2Pbtf _ => d2p0
 |D2Pchr _ => d2p0
 |D2Pflt _ => d2p0
 |D2Pstr _ => d2p0
 //
+|D2Pi00 _ => d2p0
+|D2Pb00 _ => d2p0
+|D2Pc00 _ => d2p0
+|D2Ps00 _ => d2p0
+//
 |D2Pcon _ => d2p0
 //
 |D2Pcons _ => d2p0
 //
+(*
+// HX: removed!
 |D2Psym0 _ => d2p0
+*)
 //
 |D2Pbang _ => f0_bang(d2p0, err)
 |D2Pflat _ => f0_flat(d2p0, err)
@@ -1183,19 +1186,68 @@ val-
 D2Pdapp
 (d2f0
 ,npf1, d2ps) = d2p.node()
+//
 val
-d2f0 = tread12_d2pat(d2f0, err)
+d2f0 =
+(
+  tread12_d2pat(d2f0, err))
 val
-d2ps = tread12_d2patlst(d2ps, err)
+d2ps =
+(
+  tread12_d2patlst(d2ps, err))
+//
+val () =
+// HX: [d2f0] is required to
+f1_conq(d2f0, err) // be a d2con!
+//
 in//let
-if
+//
+if // if
 (err=e00)
 then (d2p) else
 let
+//
 val loc = d2p.lctn() in
 d2pat_dapp_errck(loc,d2f0,npf1,d2ps)
-end (*let*) // end-of-[else]
-end (*let*) // end of [f0_dapp(d2p,err)]
+//
+end (*let*) // else // end-of-[if]
+end where
+{
+//
+fun
+f1_conq
+(d2p: d2pat
+,err: &sint >> _): void =
+(
+case+
+d2p.node() of
+//
+|D2Pcon
+(  d2c1  ) => ((*void*))
+//
+|D2Pbang
+(  d2p1  ) => f1_conq(d2p1, err)
+|D2Pflat
+(  d2p1  ) => f1_conq(d2p1, err)
+|D2Pfree
+(  d2p1  ) => f1_conq(d2p1, err)
+//
+|D2Psapp
+( d2p1, s2vs ) => f1_conq(d2p1, err)
+//
+|_(*otherwise*) => (err := (err + 1))
+) where
+{
+//
+(*
+val () =
+prerrsln("\
+tread12_d2pat:f0_dapp:f1_conq: d2p = ", d2p)
+*)
+//
+}(*case+*) // end-of-[f1_conq(d2p,err)]
+//
+} (*where*) // end of [f0_dapp(d2p,err)]
 //
 (* ****** ****** *)
 //

diff --git a/srcgen2/SATS/dynexp3.sats b/srcgen2/SATS/dynexp3.sats
@@ -301,6 +301,9 @@ d3pat_node =
 |D3Ptapq of
  (d3pat, t2jaglst(*targ*))
 //
+(*
+|D3Pdap0 of (d3pat)//nullary
+*)
 |D3Pdap1 of (d3pat)//argless
 //
 |D3Pdapp of

diff --git a/srcgen2/UTIL/TEST/Makefile b/srcgen2/UTIL/TEST/Makefile
@@ -13,43 +13,23 @@ NODE=node
 all:: test01
 ########################################################################
 ########################################################################
-testall:: test01; $(NODE) $<_out.js
+testall:: test01; $(NODE) $<_out.txt
 ########################################################################
 ########################################################################
 SRCGEN2_SRCGENX=\
 $(XATSHOME)/srcgen2/xats2js/srcgenx
-SRCGEN2_XSHARED=\
-$(XATSHOME)/srcgen2/xats2js/srcgenx/xshared/runtime
 SRCGEN2_XATS2JS=\
-$(XATSHOME)/srcgen2/xats2js/srcgenx/UTIL/xats2js_jsemit00_dats.js
+$(XATSHOME)/srcgen2/UTIL/xatsopt_tcheck00_dats.js
 ########################################################################
 ########################################################################
 test01:: ; \
-echo "//" `date` > $@_out.js
-############
-test01:: ; \
-$(CAT) $(SRCGEN2_XSHARED)/xats2js_js1emit.js >> $@_out.js
-test01:: ; \
-$(CAT) $(SRCGEN2_XSHARED)/xats2js_prelude.js >> $@_out.js
-test01:: ; \
-$(CAT) $(SRCGEN2_XSHARED)/xats2js_xatslib.js >> $@_out.js
-test01:: ; \
-$(CAT) $(SRCGEN2_XSHARED)/xats2js_prelude_node.js >> $@_out.js
+echo "//" `date` > $@_out.txt
 ############
 test01:: test01_mydebug.dats; \
-$(NODE) --stack-size=4096 $(SRCGEN2_XATS2JS) $< >> $@_out.js
-############
-# test01:: ; \
-# npx google-closure-compiler -W QUIET \
-#   --compilation_level SIMPLE --js=$@_out.js --js_output_file=$@_out1.js
-# test01:: ; \
-# npx google-closure-compiler -W QUIET \
-#   --compilation_level ADVANCED --js=$@_out.js --js_output_file=$@_out2.js
-########################################################################
+$(NODE) --stack-size=4096 $(SRCGEN2_XATS2JS) $< >> $@_out.txt
 ########################################################################
 clean:: ; rm -f *~
 cleanall:: ; rm -f *~
-cleanall:: ; rm -f test01_out.js
-cleanall:: ; rm -f test01_out?.js
+cleanall:: ; rm -f test01_out.txt
 ########################################################################
-###################### end of [Makefile_jsemit] ########################
+###################### end of [Makefile_tcheck] ########################
diff --git a/srcgen2/UTIL/TEST/test01_mydebug.dats b/srcgen2/UTIL/TEST/test01_mydebug.dats
@@ -42,7 +42,18 @@ val () = prints
 //
 (* ****** ****** *)
 (* ****** ****** *)
-
+//
+datatype ab =
+| A of () | B of ()
+//
+(* ****** ****** *)
+//
+fun f_ab(x: ab): sint =
+case+ x of A => 0 | B _ => 1 | C() => 2
+//
+(* ****** ****** *)
+(* ****** ****** *)
+//
 (* ****** ****** *)(* ****** ****** *)(* ****** ****** *)
 (* ****** ****** *)(* ****** ****** *)(* ****** ****** *)
 

diff --git a/srcgen2/UTIL/xatsopt_tcheck00.dats b/srcgen2/UTIL/xatsopt_tcheck00.dats
@@ -113,10 +113,10 @@ let
 val ( ) =
 let
 //
-(*
+// (*
 val (   ) =
 prerrsln("dpar3 = ", dpar3)
-*)
+// *)
 //
 in//let
 //