config-strict := True_u8; config-preprocess := True_u8; config-target := 'tmp.s_s; config-assemble-mode := (: AssembleGNU AssembleMode); config-mode := (: ModeCompile CompileMode); preprocess-macros := (: MEOF MacroList); ast-tokenized-program := (: LEOF List); ast-parsed-program := (: ASTEOF AST); global-type-context := (: TCtxEOF TContext); var-name-if-var := λ(: t AST). (: ( (let k '_s) (match t ( () ( (Var( nk _ )) (set k nk) ) ( (Lit( nk _ )) (set k nk) ) ( _ () ) )) k ) String); print := λ(: t Token). (: ( (match t ( () ( (Token( v _ _ )) (print v) ) )) ) Nil); print := λ(: t Context). (: ( (match t ( () ( CtxEOF () ) ( CtxNil () ) ( (CtxBind( rst k v )) ( (print rst) (print k) (print '\s=\s_s) (print v) (print '\:\n_s) )) )) ) Nil); + := λ(: l AST)(: r AST). (: ( (match r ( () ( ASTEOF () ) ( (Seq( rl rr )) ( (set l (+( l rl ))) (set l (+( l rr ))) )) ( re ( (set l (Seq( (close l) (close re) ))) )) )) l ) AST); print := λ(: t TContext). (: ( (match t ( () ( TCtxEOF () ) ( TCtxNil () ) ( (TCtxBind( rst k v )) ( (print rst) (print k) (print '\s:\s_s) (print v) (print '\:\n_s) )) )) ) Nil); print := λ(: t AST). (: ( (match t ( () ( ASTEOF (print 'EOF_s) ) ( ASTNil (print '\[\]_s) ) ( (Var( a _ )) (print a) ) ( (Lit( a _ )) ( (print '\`_s) (print a) )) ( (AType a) (print a) ) ( (Meta _) (print 'Meta_s) ) ( (Typedef( lhs rhs )) ( (print 'type\s_s) (print lhs) (print '\s=\s_s) (print rhs) )) ( (Glb( k v )) ( (print k) (print '\s:=\s_s) (print v) )) ( (Frg( k_t v )) ( (print 'fragment\s_s) (print k) (print '\s:=\s_s) (print v) )) ( (App( l r )) ( (print '\[_s) (print l) (print '\s_s) (print r) (print '\]_s) )) ( (Abs( lhs rhs tlt )) ( (print '\[_s) (print '\l_s) (print lhs) (print '._s) (print rhs) (print '\]_s) )) ( (Seq( l r )) ( (print l) (print '\:\n_s) (print r) )) )) ) Nil); reverse := λ(: fl FragmentList). (: ( (let r FLEOF) (while (non-zero fl) (match fl ( () ( (FLSeq( rst fi )) ( (set r (FLSeq( (close r) fi ))) (set fl rst) )) ))) r ) FragmentList); serialize-ast := λ(: t AST). (: ( (match t ( () ( ASTEOF (print '\[\]_s) ) ( ASTNil (print 'Nil_s) ) ( (Meta _) (print 'Meta_s) ) ( (Var( a _ )) ( (print '\[Variable\s_s) (print a) (print '\]_s) )) ( (Lit( a _ )) ( (print '\[Literal\s_s) (print a) (print '\]_s) )) ( (AType a) (serialize-ast a) ) ( (Typedef( lhs rhs )) ( (print '\[Type\s\[_s) (serialize-ast lhs) (print '\s_s) (serialize-ast rhs) (print '\]\]_s) )) ( (Glb( lhs rhs )) ( (print '\[Global\s\[_s) (print lhs) (print '\s_s) (serialize-ast rhs) (print '\]\]_s) )) ( (Frg( lhs_t rhs )) ( (print '\[Fragment\s\[_s) (print lhs) (print '\s_s) (serialize-ast rhs) (print '\]\]_s) )) ( (App( lhs rhs )) ( (print '\[App\s\[_s) (serialize-ast lhs) (print '\s_s) (serialize-ast rhs) (print '\]\]_s) )) ( (Abs( lhs rhs tlt )) ( (print '\[Lambda\s\[_s) (serialize-ast lhs) (print '\s_s) (serialize-ast rhs) (print '\]\]_s) )) ( (Seq( ASTEOF r )) ( (serialize-ast r) (print '\n_s) )) ( (Seq( l r )) ( (serialize-ast l) (serialize-ast r) (print '\n_s) )) )) ) Nil); serialize-ast := λ(: tt List). (: (match tt ( () ( LEOF () ) ( (LCons( p1 LEOF )) (serialize-ast p1) ) ( (LCons( p1 rst )) ( (print '\[App\s\[_s) (serialize-ast rst) (print '\s_s) (serialize-ast p1) (print '\]\]_s) )) )) Nil); serialize-ast := λ(: tt Type). (: (match tt ( () ( TAny (print '\[Variable\s?\]_s) ) ( (TVar( vn )) ( (print '\[Variable\s_s) (print vn) (print '\]_s) )) ( (TAnd( lt rt )) ( (print '\[App\s\[_s) (print '\[Literal\sAnd\]\s_s) (print '\[App\s\[_s) (serialize-ast lt) (print '\s_s) (serialize-ast rt) (print '\]\]_s) (print '\]\]_s) )) ( (TGround( tag LEOF )) ( (print '\[Literal\s_s) (print tag) (print '\]_s) )) ( (TGround( tag ps )) ( (print '\[App\s\[_s) (print '\[Literal\s_s) (print tag) (print '\]\s_s) (serialize-ast ps) (print '\]\]_s) )) )) Nil); print := λ(: ctx FContext). (: ( (print 'Fragment\sContext:\n_s) (while (non-zero ctx) (match ctx ( () ( (FCtxBind( rst k kt kf )) ( (print k)(print '\s:\s_s)(print kt)(print '\n_s)(print kf) (set ctx rst) )) ))) ) Nil); print := λ(: x Fragment). (: ( (match x ( () ( (Fragment( e-t kvs offset xtt ctx )) ( (print 'Fragment\n_s) (print '\tOffset\s=\s_s)(print offset)(print '\n_s) (while (non-zero kvs) (match kvs ( () ( (FKVSeq( rst k v )) ( (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 )) ( (print rst) (print f) )) ( _ () ) )) ) Nil); print := λ(: loc SourceLocation). (: ( (match loc ( () ( (SourceLocation( fp ln cl )) ( (print 'In\sFile\s_s) (print fp) (print '\sLine\s_s) (print ln) (print '\sColumn\s_s) (print cl) )) )) ) Nil); print := λ(: tt Type). (: (match tt ( () ( TAny (print '?_s) ) ( (TVar( vn )) (print vn) ) ( (TGround( tag LEOF )) (print tag) ) ( (TAnd( lt rt )) ( (if (is-arrow lt) ( (print lt) (print '\s+\n_s) (print rt) ) ( (print lt) (print '\s+\s_s) (print rt) )) )) ( (TGround( tag ps )) ( (print tag) (print '<_s) (print ps) (print '>_s) )) )) Nil); print := λ(: tt List). (: (match tt ( () ( LEOF () ) ( (LCons( p1 LEOF )) (print p1) ) ( (LCons( p1 rst )) ( (print rst) (print ',_s) (print p1) )) )) Nil); is-arrow := λ(: tt Type). (: ( (let r 0_u64) (match (slot( tt 'Arrow_s )) ( () ( (TGround( 'Arrow_s _ )) (set r 1_u64) ) ( _ () ) )) r ) U64); slot := λ(: tt Type)(: sl String). (: ( (let rt TAny) (match tt ( () ( (TGround( bt _ )) ( (if (==( bt sl )) (set rt tt) ()) )) ( (TAnd( ltt rtt )) ( (let lt2 (slot( ltt sl ))) (if (non-zero lt2) ( (set rt lt2) ) ( (let rt2 (slot( rtt sl ))) (set rt rt2) )) )) ( _ () ) )) rt ) Type); slot := λ(: tt Type)(: s1 String)(: s2 String). (: ( (let rt TAny) (match tt ( () ( (TGround( bt mt )) ( (if (==( bt s1 )) ( (match mt ( () ( (TGround( mtt _ )) ( (if (==( mtt s2 )) ( (set rt tt) ) ()) )) ( _ () ) )) ) ()) )) ( (TAnd( ltt rtt )) ( (let lt2 (slot( ltt s1 ))) (if (non-zero lt2) ( (set rt lt2) ) ( (let rt2 (slot( rtt s1 ))) (set rt rt2) )) )) ( _ () ) )) rt ) Type); uuid-counter := 0_u64; uuid := λ . (: ( (set uuid-counter (+( uuid-counter 1_u64 ))) (clone-rope (SCons( (close(SAtom 'uuid__s)) (close(SAtom(to-hex uuid-counter))) ))) ) String); iuid := λ . (: ( (set uuid-counter (+( uuid-counter 1_u64 ))) (let id uuid-counter) id ) U64);