print := λ(: x Fragment). (: (
(match x (
()
( (Fragment( kvs offset xtt ctx )) (tail(
(print 'Fragment\n_s)
(print '\tOffset\s=\s_s)(print offset)(print '\n_s)
(while (non-zero kvs) (match kvs (
()
( (FKVSeq( rst k v )) (tail(
(print '\t_s)(print k)(print '\s=\s_s)(print v)(print '\n_s)
(set kvs rst)
)))
)))
)))
))
) Nil);
print := λ(: x FragmentList). (: (
(match x (
()
( (FLSeq( rst f )) (tail(
(print rst)
(print f)
)))
( _ () )
))
) Nil);
fragment::new := λ . (: (tail(
(let r (Fragment(
(close FKVEOF)
0_i64
TAny
(close(fragment-context::new()))
)))
r
)) Fragment);
fragment::get := λ(: e Fragment)(: k String). (: (tail(
(let r SNil)
(match e (
()
( (Fragment( kvs offset ft ctx )) (
(while (non-zero kvs) (match kvs (
()
( (FKVSeq( rst kvs-k kvs-v )) (
(if (==( k kvs-k )) (tail(
(set r kvs-v)
(set kvs FKVEOF)
)) (set kvs rst))
))
)))
))
))
r
)) S);
fragment::set := λ(: e Fragment)(: k String)(: v S). (: (tail(
(let r e)
(match e (
()
( (Fragment( kvs offset ft ctx )) (
(set r (Fragment(
(close(FKVSeq( (close kvs) k v )))
offset ft (close ctx)
)))
))
))
r
)) Fragment);
fragment::get-type := λ(: e Fragment) . (: (tail(
(let tt (maybe-deref(.2( (as e Fragment) ))))
tt
)) Type);
fragment::set-type := λ(: e Fragment)(: tt Type). (: (tail(
(let r e)
(match e (
()
( (Fragment( e-kvs e-offset e-tt e-ctx )) (
(set r (Fragment( (close e-kvs) e-offset tt (close e-ctx) )))
))
))
r
)) Fragment);
fragment::local-variable := λ(: offset I64)(: tt Type). (: (tail(
(let r (fragment::new()))
(set r (fragment::set( r 'expression_s (SAtom(to-string offset)) )))
(set r (fragment::set( r 'fragment-type_s (SAtom 'LocalVariable_s) )))
(set r (fragment::set-type( r tt )))
r
)) Fragment);
fragment::label := λ(: id String). (: (tail(
(let r (fragment::new()))
(set r (fragment::set( r 'expression_s (SAtom id) )))
(set r (fragment::set( r 'fragment-type_s (SAtom 'Label_s) )))
(set r (fragment::set-type( r (t1 'Label_s) )))
r
)) Fragment);
fragment::expression := λ(: val String). (: (tail(
(let r (fragment::new()))
(set r (fragment::set( r 'expression_s (SAtom val) )))
r
)) Fragment);
fragment::expression := λ(: val S). (: (tail(
(let r (fragment::new()))
(set r (fragment::set( r 'expression_s val )))
r
)) Fragment);
fragment::get-context := λ(: e Fragment) . (: (tail(
(let ctx (maybe-deref(.1( (as e Fragment) ))))
ctx
)) FContext);
fragment::set-context := λ(: e Fragment)(: ctx FContext). (: (tail(
(let r e)
(match e (
()
( (Fragment( e-kvs e-offset e-tt e-ctx )) (
(set r (Fragment( (close e-kvs) e-offset e-tt (close ctx) )))
))
))
r
)) Fragment);
fragment::get-offset := λ(: e Fragment). (: (tail(
(let offset 0_i64)
(match e (
()
( (Fragment( e-kvs e-offset e-tt e-ctx )) (
(set offset e-offset)
))
))
offset
)) I64);
fragment::set-offset := λ(: e Fragment)(: offset I64). (: (tail(
(let r e)
(match e (
()
( (Fragment( e-kvs e-offset e-tt e-ctx )) (
(set r (Fragment(
(close e-kvs) offset e-tt (close e-ctx)
)))
))
))
r
)) Fragment);
fragment::unlet := λ(: s S). (: (tail(
(let return s)
(match s (
()
( (SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'Abs_s) (SCons(
(SCons( (SAtom 'Var_s) (SAtom _) ))
SNil
)) ))
v
)) )) (set return SNil) )
( (SCons( (SAtom 'App_s) (SCons(
ls rs
)) )) (tail(
(let ls-2 (fragment::unlet( ls )))
(if (not(is( ls ls-2 ))) (
(set return (SCons( (close(SAtom 'App_s)) (close(SCons(
(close ls-2) (close rs)
))) )) )
) ())
)))
( _ () )
))
return
)) S);
fragment::let := λ(: ctx FContext)(: s S). (: (tail(
(let return ctx)
(match s (
()
( (SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'Abs_s) (SCons(
(SCons( (SAtom 'Var_s) (SAtom k) ))
SNil
)) ))
v
)) )) (tail(
(set v (fragment::render( return v )))
(set return (FCtxBind(
(close return) k TAny (fragment::expression( v ))
)))
)))
( (SCons( (SAtom 'App_s) (SCons(
ls rs
)) )) (
(set return (fragment::let( return ls )))
))
( _ () )
))
return
)) FContext);
fragment::render := λ(: ctx FContext)(: s S). (: (tail(
(let s-2 (fragment::unlet( s )))
(while (not(is( s s-2 ))) (
(set ctx (fragment::let( ctx s )))
(set s s-2)
(set s-2 (fragment::unlet( s )))
) ())
(let return (fragment::render-impl( ctx s )))
return
)) S);
fragment::render-impl := λ(: ctx FContext)(: s S). (: (tail(
(let r SNil)
(match s (
()
( SNil () )
( (SCons( (SAtom 'Var_s) (SAtom v) )) (tail(
(print 'Raw\sVariables\sNot\sPermitted\sIn\sFragments:\s_s)
(print v)(print '\n_s)
(exit 1_u64)
)))
( (SCons( (SAtom 'Lit_s) (SAtom v) )) (set r (SAtom v)) )
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom 'inv_s) )) lc )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(set r (SAtom(to-string (-( 0_i64 li )) )))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom 'align_s) )) lc )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (max( (to-i64 lai) 8_i64 ))) )
( _ () )
))
(set r (SAtom(to-string li)))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom '>_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(if (>( li ri )) (
(set r (SAtom '1_s))
) (
(set r (SAtom '0_s))
))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom 'max_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(set r (SAtom(to-string(max( li ri )))))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom '+_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(set r (SAtom(to-string(+( li ri )))))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom '-_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(set r (SAtom(to-string(-( li ri )))))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom '*_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(set r (SAtom(to-string(*( li ri )))))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom '/_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(if (>( ri 0_i64 )) (
(set r (SAtom(to-string(/( li ri )))))
) ())
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom '%_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(if (>( ri 0_i64 )) (
(set r (SAtom(to-string(%( li ri )))))
) ())
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom 'range_s) )) (SCons( (SAtom 'App_s) (SCons( lc rc )) )) )) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let li 0_i64)
(match lt (
()
( (SAtom lai) (set li (to-i64 lai)) )
( _ () )
))
(let rt (fragment::render-impl( ctx rc )))
(let ri 0_i64)
(match rt (
()
( (SAtom rai) (set ri (to-i64 rai)) )
( _ () )
))
(while (<( li ri )) (tail(
(set ri (-( ri 1_i64 )))
(set r (SCons( (close(SAtom(to-string ri))) (close r) )))
)))
)))
( (SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'Var_s) (SAtom 'if-eq_s) )) lc
)) )) rc
)) )) body
)) )) (tail(
(let lt (fragment::render-impl( ctx lc )))
(let rt (fragment::render-impl( ctx rc )))
(if (==( lt rt )) (tail(
(let bodyt (fragment::render-impl( ctx body )))
(set r bodyt)
)) ())
)))
( (SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'App_s) (SCons(
(SCons( (SAtom 'Var_s) (SAtom 'for_s) ))
(SCons( (SAtom 'Var_s) (SAtom binding) ))
)) ))
(SCons( (SAtom 'Var_s) (SAtom 'in_s) ))
)) )) iter
)) )) body
)) )) (tail(
(let iter-result (fragment::render-impl( ctx iter )))
(while (non-zero iter-result) (match iter-result (
()
( (SCons( (SAtom i) rst )) (tail(
(let fi (fragment::expression i))
(let fi-2 (fragment::set( fi 'program_s (SAtom i) )))(set fi fi-2)
(let inner-ctx (FCtxBind(
(close ctx) binding TAny fi
)))
(let body-instance (fragment::render( inner-ctx body )))
(set r (SCons(
(close r)
(close body-instance)
)))
(set iter-result rst)
)))
)))
)))
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom op) )) (SCons( (SAtom 'Var_s) (SAtom v) )) )) )) (
(if (==( (head-string op) 46_u8 )) (tail(
(let f (fragment-context::lookup( ctx v TAny ASTEOF )))
(let fe (fragment::get( f (tail-string op) )))
(if (non-zero fe) () (tail(
(print 'Referenced\sVariable\sIn\sFragment\sWas\sNull\s_s)
(print v)(print '\n_s)(exit 1_u64)
)))
(set r fe)
)) (tail(
(print 'Raw\sVariables\sNot\sPermitted\sIn\sFragments:\s_s)
(print op)(print '\n_s)
(exit 1_u64)
)))
))
( (SCons( (SAtom 'App_s) (SCons( ls rs )) )) (tail(
(let lf (fragment::render-impl( ctx ls )))
(let rf (fragment::render-impl( ctx rs )))
(set r (SCons( (close lf) (close rf) )))
)))
( u (tail(
(print 'Fragment\sRender\sUnknown\s_s)(print u)(print '\n_s)(exit 1_u64)
)))
))
r
)) S);
union := λ(: ctx FContext)(: tctx TContext). (: (tail(
(let r ctx)
(while (non-zero tctx) (match tctx (
()
( TCtxNil (set tctx TCtxEOF) )
( (TCtxBind( rst k vt _ )) (tail(
(let fragment (fragment::expression(to-string vt)))
(set fragment (fragment::set( fragment 'program_s (SAtom(to-string vt)) )))
(set r (FCtxBind(
(close r) k TAny fragment
)))
(set tctx rst)
)))
)))
r
)) FContext);
fragment::render := λ(: ctx FContext)(: rhs S)(: prototype Fragment). (: (tail(
(let return prototype)
(match rhs (
()
( (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom mode) )) prg )) )) (tail(
(if (!=( (head-string mode) 46_u8 )) (fail 'Invalid\sMode\sIn\sfragment::render_s) ())
(let s (fragment::render( ctx prg )))
(set return (fragment::set( return (tail-string mode) s )))
)))
( (SCons( (SAtom 'App_s) (SCons( rst (SCons( (SAtom 'App_s) (SCons( (SCons( (SAtom 'Var_s) (SAtom mode) )) prg )) )) )) )) (tail(
(if (!=( (head-string mode) 46_u8 )) (fail 'Invalid\sMode\sIn\sfragment::render_s) ())
(let s (fragment::render( ctx prg )))
(set return (fragment::set( return (tail-string mode) s )))
(set return (fragment::render( ctx rst return )))
)))
( SNil () )
( prg (tail(
(print 'Invalid\sRHS\sIn\sfragment::render\s_s)
(print prg)
(exit 1_u64)
)))
))
return
)) Fragment);